20170706pptVBA演示文稿批量删除图片

Public Sub StartRecursionFolder()
    Dim Pre As Presentation
    Dim FolderPath As String
    Dim pp As String
    Dim id As String
    Dim oFileDialog As FileDialog
    Set oFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    Set Pre = Application.ActivePresentation
    With oFileDialog
        .AllowMultiSelect = False
        '.InitialFileName = Pre.Path & "\"
        If .Show = 0 Then Exit Sub
    End With
    FolderPath = oFileDialog.SelectedItems(1) & "\"
    '递归处理
    RecursionFolder FolderPath
    MsgBox "批处理完成"
End Sub
Public Sub PresentationHandle(ByVal FilePath As String)
    Application.DisplayAlerts = ppAlertsNone
    Dim Pre As Presentation
    Dim mst As Master
    Dim Shp As Shape
    Debug.Print FilePath
    Set Pre = Application.Presentations.Open(FilePath)
    '******************************母版的处理**********************
    Set mst = Pre.SlideMaster
    For Each Shp In mst.Shapes
            '删除条件
            If BetweenSize(Shp.Width, 145, 160) And BetweenSize(Shp.Height, 30, 55) Then
                  Shp.Delete
            End If
    Next Shp

    Pre.Save
    Pre.Close

    Set Pre = Nothing
    Set mst = Nothing
    Set sld = Nothing


    Application.DisplayAlerts = ppAlertsAll
End Sub
Private Function BetweenSize(ByVal Size As Double, ByVal MinSize As Double, ByVal MaxSize As Double) As Boolean
      If Size > MinSize And Size < MaxSize Then
            BetweenSize = True
      Else
            BetweenSize = False
      End If
End Function
Public Sub RecursionFolder(ByVal FolderPath As String)    '递归文件夹
'声明对象
    Dim Fso As Object
    Dim MainFolder As Object
    Dim OneFolder As Object
    Dim OneFile As Object
    '实例化对象
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set MainFolder = Fso.GetFolder(FolderPath)
    '对文件执行操作
    For Each OneFile In MainFolder.Files
        If OneFile.Name Like "*.ppt*" Then
           '具体要做的事情
            PresentationHandle OneFile.Path
        End If
    Next
    '递归
    For Each OneFolder In MainFolder.SubFolders
        RecursionFolder OneFolder.Path
    Next
    '释放对象
    Set Fso = Nothing
    Set MainFolder = Nothing
End Sub

　　

转载于:https://www.cnblogs.com/nextseven/p/7126627.html