如何使用VBA清除PowerPoint中所有信息的Slide Master?

时间:2017-06-14 20:27:15

标签: vba loops powerpoint slide powerpoint-vba

我想打开当前文件夹中的每个PowerPoint(* .pptx)并清除所有图像和文本框的幻灯片母版,然后保存。

(它说我的帖子主要是代码所以我需要添加更多细节,所以这里引用乔治华盛顿的话,“如果你尊重自己的声誉,请与优质男士联系;因为独自比在坏公司“)

新代码

Sub DeleteSlideMasterShapes()
    Dim i As Long
    Dim shp As Shape

    With ActivePresentation
        For i = .Designs.Count To 1 Step -1
            For Each shp In .Designs(i).SlideMaster.Shapes
                shp.Delete
            Next
        Next i
    End With
End Sub

Sub loopFiles()

Dim fso As New FileSystemObject
Dim fil As File
Dim fold As Folder
Dim yourfolder As String

Set fold = fso.GetFolder(Application.ActivePresentation.Path)

For Each fil In fold.Files

    If InStr(1, fil.Name, ".pptx") > 0 Then
        Application.Presentations.Open fil.Path

        Call DeleteSlideMasterShapes

        ActivePresentation.Save
        ActivePresentation.Close

    End If

Next fil

End Sub

2 个答案:

答案 0 :(得分:0)

根据我的评论,如果您想删除幻灯片母版,请使用此

Sub DeleteSlideMaster()
    Dim i As Long

    With ActivePresentation
        On Error Resume Next
        For i = .Designs.Count To 1 Step -1
            .Designs(i).SlideMaster.Delete
        Next i
        On Error GoTo 0
    End With
End Sub

要删除幻灯片管理员的形状,请使用此

Sub DeleteSlideMasterShapes()
    Dim i As Long
    Dim shp As Shape

    With ActivePresentation
        For i = .Designs.Count To 1 Step -1
            For Each shp In .Designs(i).SlideMaster.Shapes
                shp.Delete
            Next
        Next i
    End With
End Sub

如果我不理解您的查询,请随时提问

答案 1 :(得分:0)

另一种方法,如果你想删除所有幻灯片大师和主人布局中的所有形状:

Sub DeleteSlideMasterShapes()
'   Including shapes on layouts

    Dim oDes As Design
    Dim oLay As CustomLayout

    With ActivePresentation

        ' For each slide master:
        For Each oDes In .Designs

            ' Delete the shapes on the master
            oDes.SlideMaster.Shapes.Range.Delete

            ' Then delete the shapes from each layout under
            ' the slide master:
            For Each oLay In oDes.SlideMaster.CustomLayouts
                oLay.Shapes.Range.Delete
            Next

        Next

    End With

End Sub