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