
用vba如果修改所有ppt母版 10
有一张幻灯片,有n个母版(n>=1),我想用vba在这n个母版里全部都加入一个文本框,文本框里内容是“abcd”,然后把这个文本框置于每个母版的底部vba怎么写???...
有一张幻灯片,有n个母版(n>=1),我想用vba在这n个母版里全部都加入一个文本框,文本框里内容是“abcd”,然后把这个文本框置于每个母版的底部
vba怎么写??? 展开
vba怎么写??? 展开
1个回答
展开全部
'把下面的代码放到任意一个PPT的模块里,按提示做简单修改(变量定义中的2处),运行就可以了。
sub ChgTheme()
'模板名称,及要修改母版的PPT所在的文档
Dim strThemeName As String, strFolder As String
strThemeName = "D:\Program Files\Microsoft Office\Templates\2052\ContemporaryPhotoAlbum.potx" '母版,修改成自己的吧
strFolder = "C:\Users\lx\Desktop\PPTStudy" '要修改的PPT,修改成自己的吧
Dim pres As Presentation
Dim Fs, oFolder, f1, FColloll, s
Set Fs = CreateObject("Scripting.FileSystemObject")
Set oFolder = Fs.GetFolder(strFolder)
Set FColl = oFolder.Files
For Each f1 In FColl
If f1 Like "*.pptx" Or f1 Like "*.pptm" Then '只对pptx文档处理
If ActivePresentation.Name = f1.Name Then '将主题或设计模板应用于当前演示文稿。
ActivePresentation.ApplyTheme strThemeName
ActivePresentation.Save
ElseIf Left(f1.Name, 2) <> "~$" Then '将主题或设计模板应用于指定的演示文稿
Set pres = Presentations.Open(FileName:=f1, WithWindow:=msoFalse)
pres.ApplyTheme strThemeName
pres.Save
pres.Close
End If
End If
Next
Set pres = Nothing
Set FColl = Nothing
Set oFolder = Nothing
Set Fs = Nothing
End Sub
sub ChgTheme()
'模板名称,及要修改母版的PPT所在的文档
Dim strThemeName As String, strFolder As String
strThemeName = "D:\Program Files\Microsoft Office\Templates\2052\ContemporaryPhotoAlbum.potx" '母版,修改成自己的吧
strFolder = "C:\Users\lx\Desktop\PPTStudy" '要修改的PPT,修改成自己的吧
Dim pres As Presentation
Dim Fs, oFolder, f1, FColloll, s
Set Fs = CreateObject("Scripting.FileSystemObject")
Set oFolder = Fs.GetFolder(strFolder)
Set FColl = oFolder.Files
For Each f1 In FColl
If f1 Like "*.pptx" Or f1 Like "*.pptm" Then '只对pptx文档处理
If ActivePresentation.Name = f1.Name Then '将主题或设计模板应用于当前演示文稿。
ActivePresentation.ApplyTheme strThemeName
ActivePresentation.Save
ElseIf Left(f1.Name, 2) <> "~$" Then '将主题或设计模板应用于指定的演示文稿
Set pres = Presentations.Open(FileName:=f1, WithWindow:=msoFalse)
pres.ApplyTheme strThemeName
pres.Save
pres.Close
End If
End If
Next
Set pres = Nothing
Set FColl = Nothing
Set oFolder = Nothing
Set Fs = Nothing
End Sub
本回答被网友采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?

2024-10-22 广告
百事牛是共享提供商,我们提供可靠有效的服务,适当合理的授权费有利于的继续更新优化。同样的事情,同样的方法,百事牛团队十年磨一剑,始终至聚焦在密码恢复领域,深耕于此,我们已研制出有别于其他公司的算法和运算模式, 百事牛的暴力模式加入了分布式点...
点击进入详情页
本回答由百事牛提供
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询