PPT批量修改母版（转载）

把这个代码插入excle——VBE中

 

Sub 批量修改母版()
    Application.ScreenUpdating = False
    DZ母版 = "D:\Desktop\模板.pptx"  \'母版地址
    Set fso = CreateObject("scripting.filesystemobject")
    Set ff = fso.GetFolder(ThisWorkbook.Path) \'ThisWorkbook.Path是当前代码文件所在路径，路径名可以根据需求修改
    ActiveSheet.UsedRange.ClearContents
    a = 1
    For Each f In ff.Files
        If f Like "*.pptx" Then
\'          MsgBox "发现" & f.Name
    Set Myppt = CreateObject("PowerPoint.Application")
    Myppt.Visible = True
    Set newppt = Myppt.Presentations.Open(Filename:=f)
          newppt.ApplyTemplate Filename:=DZ母版                                            \'为幻灯片选择母版
          newppt.Save
          newppt.Close
          Set newppt = Nothing
          Set Myppt = Nothing
        Cells(a, 1) = f.Name \'相对路径名
        Cells(a, 2) = f \'全路径名
        
        a = a + 1
        End If

    Next f
    
    Application.ScreenUpdating = True
End Sub