-
1 # 錢布斯
-
2 # 錢布斯
"把下面的程式碼放到任意一個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
回覆列表
"把下面的程式碼放到任意一個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