用vba如果修改所有ppt母版

发布网友发布时间：2022-04-19 11:19

共1个回答

热心网友时间：2022-06-07 10:18

'把下面的代码放到任意一个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