求批量删除word最后一页的VBA

alice2wu

求能批量删除成千上百个word最后一页的图片的工具，不是图片就不用删除，谢谢！

cookiedongo

[Visual Basic] 纯文本查看 复制代码

Sub DeleteLastPageOfDocs()

Dim fd As FileDialog
Dim aDoc As Document
Dim i As Long
Dim count As Long

Set fd = Application.FileDialog(FileDialogType:=msoFileDialogOpen)
With fd
    .AllowMultiSelect = True
    .Title = "请选择要处理的一个或多个 Word 文档"
    .Filters.Add "Word 文档", "*.doc; *.docx", 1
    If .Show = -1 Then
        count = .SelectedItems.count
        For Each vrtSelectedItem In .SelectedItems
            Set aDoc = Documents.Open(vrtSelectedItem)
            With ActiveDocument
                .Bookmarks("\EndOfDoc").Range.Select

            ' 获取当前活动页面的页码
            currentPageNumber = Selection.Information(wdActiveEndPageNumber)
            
            ' 遍历当前活动页面的内联形状对象并删除图片
            For Each shape In ActiveDocument.Shapes
                If shape.Anchor.Information(wdActiveEndPageNumber) = currentPageNumber Then
                    shape.Delete
                End If
            Next shape
            
            For Each InlineShape In ActiveDocument.InlineShapes
                If InlineShape.Range.Information(wdActiveEndPageNumber) = currentPageNumber Then
                    InlineShape.Delete
                End If
            Next InlineShape
    
            End With
            aDoc.Save
            aDoc.Close
        Next
        MsgBox "已处理 " & count & " 个 Word 文档"
    End If
End With

End Sub

没有设置读取路径，运行的时候弹窗多选你要操作的文件，点打开，会批量对其进行操作

jstar

[Visual Basic] 纯文本查看 复制代码

Sub DeleteLastPageImage()
    Dim lastPage As Page
    Dim lastShape As Shape

    '获取文档中的最后一页
    Set lastPage = ActiveDocument.ActiveWindow.Panes(1).Pages(ActiveDocument.ActiveWindow.Panes(1).Pages.Count)

    '遍历最后一页的所有Shapes
    For Each lastShape In lastPage.Shapes
        If lastShape.Type = msoPicture Then
            '如果最后一页包含图片，则删除图片
            lastShape.Delete
        End If
    Next lastShape
End Sub

alice2wu

jstar 发表于 2024-3-19 22:00
[mw_shl_code=vb,true]Sub DeleteLastPageImage()
    Dim lastPage As Page
    Dim lastShape As Shape ...

https://imgsrc.baidu.com/forum/pic/item/0b7b02087bf40ad1ae27e0d8112c11dfa8eccece.png
运行错误

MFeel1

vba
Sub DeleteLastPageImages()
    Dim folderPath As String
    Dim fileName As String
    Dim doc As Document
    Dim page As Range
    Dim shape As Shape
   
    ' 设置文件夹路径
    folderPath = "C:\Your\Folder\Path\"
   
    ' 打开文件夹中的每个Word文档
    fileName = Dir(folderPath & "*.docx")
    Do While fileName <> ""
        ' 打开Word文档
        Set doc = Documents.Open(folderPath & fileName)
        
        ' 获取最后一页的范围
        Set page = doc.Sections(doc.Sections.Count).Range
        
        ' 删除最后一页的所有图片
        For Each shape In page.Shapes
            If shape.Type = msoPicture Then
                shape.Delete
            End If
        Next shape
        
        ' 保存并关闭Word文档
        doc.Save
        doc.Close
        
        ' 继续下一个文件
        fileName = Dir
    Loop
   
    ' 释放对象
    Set page = Nothing
    Set shape = Nothing
    Set doc = Nothing
   
    MsgBox "图片已成功删除！"
End Sub



注意事项:
请确保将`folderPath`变量设置为包含要处理的Word文档的文件夹的路径。此代码将打开文件夹中的每个`.docx`文件，并删除每个文件的最后一页中的所有图片。如果最后一页没有图片，则不会进行任何更改。完成后，将显示一个消息框确认删除操作已成功完成。

希望可以帮到您

alice2wu

MFeel1 发表于 2024-3-19 23:32
vba
Sub DeleteLastPageImages()
    Dim folderPath As String

不知道什么原因哦，你知道怎么解决吗？

小哲网络

通过VBA（Visual Basic for Applications），你可以编写一个宏来批量删除Word文档最后一页的图片。请注意，VBA的处理方式会依赖于Word文档的布局和内容结构，因此你可能需要根据具体的文档进行适当的调整。以下是一个基本的VBA示例，展示了如何在Word中遍历最后一页，尝试找到并删除所有图片。这个宏假设最后一页的图片都是以InlineShape的形式插入的。如果你的文档中图片以不同的方式插入，比如通过浮动方式，则可能需要不同的处理方法。要处理多种类型的图片（包括行内和浮动图片），我们可以扩展VBA宏来覆盖更多的情况。下面的VBA宏尝试删除Word文档最后一页中的所有类型的图片，包括InlineShapes和Shapes。

[Visual Basic] 纯文本查看 复制代码

Sub DeleteAllImagesFromLastPage()
    Dim doc As Document
    Set doc = ActiveDocument
    
    Dim totalPages As Long
    totalPages = doc.ComputeStatistics(wdStatisticPages)
    
    Dim lastPageRange As Range
    Set lastPageRange = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=totalPages)
    lastPageRange.Expand wdParagraph
    
    ' 删除最后一页的InlineShapes图片
    Dim i As Long
    For i = lastPageRange.InlineShapes.Count To 1 Step -1
        If lastPageRange.InlineShapes(i).Range.Information(wdWithInTable) = False Then
            lastPageRange.InlineShapes(i).Delete
        End If
    Next i
    
    ' 删除最后一页的Shapes图片
    Dim shp As Shape
    For Each shp In doc.Shapes
        If Not (shp.Anchor Is Nothing) Then
            If shp.Anchor.Information(wdActiveEndAdjustedPageNumber) = totalPages Then
                shp.Delete
            End If
        End If
    Next shp
    
    MsgBox "All types of images from the last page have been deleted."
End Sub

要使用这个宏，请按以下步骤操作：

• 打开Word文档。
• 按下Alt + F11键打开VBA编辑器。
• 在“项目”窗口中，选择你当前的文档项目，通常形式为“Project (文档名)“。
• 右键点击这个项目，选择“插入” -> "模块"，来创建一个新的模块。
• 在新打开的模块窗口中粘贴上述代码。
• 按下F5键运行宏或关闭VBA编辑器并回到Word，通过“开发工具”->“宏”来运行名为DeleteImagesFromLastPage的宏。
  

请注意，运行VBA脚本对文档的改动是不可逆的，因此建议在执行之前备份你的文档。此外，根据你的文档内容和布局，这个基本脚本可能需要调整。例如，如果图片是以浮动形式插入的，则需要使用不同的方法来查找和删除图片。这个宏首先定位到文档的最后一页，然后分别遍历InlineShapes和Shapes集合来删除图片。对于Shapes集合，通过检查每个Shape的锚点（Anchor）的页面号是否是最后一页来决定是否删除该Shape。请按照之前提供的步骤在Word中添加并运行这个宏。注意：

• 此脚本只在简单场景下测试，根据文档的复杂程度和图片的具体插入方式，可能需要进一步的调整。
• 由于Shapes可能不仅仅包含图片（例如文本框、图表等），这可能会导致非图片元素被误删除。请在使用之前仔细检查代码以确保它满足你的具体需求。
• 建议在执行之前备份你的文档，以防止不可逆的更改导致数据丢失。
  

alice2wu

小哲网络 发表于 2024-3-20 10:07
通过VBA（Visual Basic for Applications），你可以编写一个宏来批量删除Word文档最后一页的图片。请注意， ...

可以删除，但是这个如何实现批量呢？

小哲网络

alice2wu 发表于 2024-3-20 10:31
可以删除，但是这个如何实现批量呢？

为了批量处理多个文档，我们可以将VBA宏进一步扩展，以允许用户选择一个文件夹，并对该文件夹内的所有Word文档执行删除最后一页图片的操作。这需要使用到FileDialog对象来选择文件夹，以及一些循环逻辑来遍历文件夹内的所有Word文档。以下是一个更新后的宏示例，它包括了选择文件夹和批量处理文档的功能：

[Visual Basic] 纯文本查看 复制代码

Sub DeleteImagesFromLastPageInMultipleDocuments()
    Dim folderPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder containing Word Documents"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        folderPath = .SelectedItems(1)
    End With
    
    Dim fileName As String
    fileName = Dir(folderPath & "\*.docx")
    
    While fileName <> ""
        Call ProcessDocument(folderPath & "\" & fileName)
        fileName = Dir() ' Get next file
    Wend
    
    MsgBox "Completed processing all documents."
End Sub

Sub ProcessDocument(docPath As String)
    Dim doc As Document
    Set doc = Documents.Open(docPath)
    
    Dim totalPages As Long
    totalPages = doc.ComputeStatistics(wdStatisticPages)
    
    Dim lastPageRange As Range
    Set lastPageRange = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=totalPages)
    lastPageRange.Expand wdParagraph
    
    ' Delete InlineShapes in the last page
    Dim i As Long
    For i = lastPageRange.InlineShapes.Count To 1 Step -1
        lastPageRange.InlineShapes(i).Delete
    Next i
    
    ' Delete Shapes in the last page
    Dim shp As Shape
    For Each shp In doc.Shapes
        If Not (shp.Anchor Is Nothing) Then
            If shp.Anchor.Information(wdActiveEndAdjustedPageNumber) = totalPages Then
                shp.Delete
            End If
        End If
    Next shp
    
    doc.Close wdSaveChanges
    
End Sub

这个宏首先提示用户选择一个文件夹，然后遍历该文件夹中的所有.docx文件，对每个文件调用ProcessDocument子程序来删除最后一页的图片。处理完成后，它会保存并关闭文档。请注意：

• 这个宏假设所有要处理的文档都是.docx格式。如果你需要处理其他格式的Word文档（如.doc），你可以在Dir函数的参数中相应地调整文件扩展名。
• 在处理大量文档或特别大的文档时，这个宏可能需要一些时间来完成。
• 建议在运行这个宏之前备份所有要处理的文档，以防止数据丢失。
  

要使用这个宏，请按照之前提供的步骤在Word中添加并运行名为DeleteImagesFromLastPageInMultipleDocuments的宏。