用VBA批量删除PowerPoint第一页和最后2页

左小光

求助：用VBA批量删除PowerPoint第一页和最后2页

左小光

因为他们是广告

左小光

有很多文件，因为他们里有广告 ，每个文件有几十张，我不要第1页与

文件名 ( [url=]插入全部附件[/url] )

描述

[url=]5.1.2 垂线.zip[/url]

[url=]删除[/url]

最后2页，附件太大，我删除些如下：

左小光

  这是我过去删除课件第一页和最后一页的方法，当时在网上搜的，自己略改了一下，现在我就看不懂了，寻求大家的帮助
Sub 遍历FSO递归删优翼课件广告()
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myPath$ = .SelectedItems(1) Else Exit Sub
    End With
    If Right(myPath, 1) <> "" Then myPath = myPath & ""
   
    Call ListAllFso(myPath)   '调用FSO遍历子文件夹的递归过程
   
End Sub

Function ListAllFso(myPath$) '用FSO方法遍历并列出所有文件和文件夹名的【递归过程】
    Set fld = CreateObject("Scripting.FileSystemObject").GetFolder(myPath)
    '用FSO方法得到当前路径的文件夹对象实例 注意这里的【当前路径myPath是个递归变量】
   
    For Each f In fld.Files  '遍历当前文件夹内所有【文件.Files】
        
        
        
        e$ = f.Name
        a$ = "*.pptx"
        If e Like a Then
            Dim doc As Presentation
            Set doc = Presentations.Open(myPath & "\" & e, , , msoFalse)
            With doc
                On Error Resume Next
                .Slides(1).Delete
                .Slides(1).Shapes.Range(Array("object 5", "text box 6", "text box 33")).Delete
                .Slides(.Slides.Count).Delete
                Dim oPic As Shape
    For i = 1 To .Slides.Count

    Set oPic = doc.Slides(i).Shapes.AddPicture("E:\OneDrive - engage collaborative solutions\装电脑资料用\z002.png", False, True, 570, 0, -1, -1)
                Next i
                With doc.SlideMaster.Background.Fill
                    .ForeColor.RGB = RGB(255, 255, 255)
                    .BackColor.RGB = RGB(250, 255, 250)
                    .TwoColorGradient msoGradientHorizontal, 1
'渐变样式与效果
'msoGradientHorizontal（1，水平渐变）
'msoGradientVertical（2，垂直渐变）
'msoGradientDiagonalUp（3，斜上对角渐变）
'msoGradientDiagonalDown（4，斜下对角渐变）
'msoGradientFromCorner（5，角部辐射渐变）
'msoGradientFromTitle（6，标题辐射渐变）
'msoGradientFromCenter（7，中心辐射渐变）
                End With
                On Error Resume Next
                .Save
                .Close
            End With
        End If
        
        
        
        
    Next
   
    For Each fd In fld.SubFolders  '遍历当前文件夹内所有【子文件夹.SubFolders】
        
        Call ListAllFso(fd.Path)       '注意此时的路径变量已经改变为【子文件夹的路径fd.Path】
        '注意重点在这里： 继续向下调用递归过程【遍历子文件夹内所有文件文件夹对象】
    Next
End Function