word 创建宏，根据选取相同的图片删除图片

Sub DeleteImages()  
    Dim i As Long  
    Dim SourceWidth As Single  
    Dim SourceHeight As Single  
    Dim DeleteCounter As Long  
  
    ' Check if a picture is selected  
    If Selection.InlineShapes.Count > 0 Then  
        ' Save the dimensions of the source image  
        SourceWidth = Selection.InlineShapes(1).Width  
        SourceHeight = Selection.InlineShapes(1).Height  
    Else  
        MsgBox "No image selected"  
        Exit Sub  
    End If  
  
    ' Initialize DeleteCounter  
    DeleteCounter = 0  
  
    ' Loop backwards through all images in the document  
    For i = ActiveDocument.InlineShapes.Count To 1 Step -1  
        ' Compare the images  
        If SourceWidth = ActiveDocument.InlineShapes(i).Width And SourceHeight = ActiveDocument.InlineShapes(i).Height Then  
            ' Images are the same size, delete the target image and increment DeleteCounter  
            ActiveDocument.InlineShapes(i).Delete  
            DeleteCounter = DeleteCounter + 1  
        End If  
    Next i  
  
    ' Output the number of deleted images  
    MsgBox "Number of deleted images: " & DeleteCounter  
End Sub  

 

 

 

Sub SelectNextSameSizeImage()  
    Dim SourceWidth As Single  
    Dim SourceHeight As Single  
    Dim i As Long  
    Dim FoundMatch As Boolean  
  
    ' Check if a picture is selected  
    If Selection.InlineShapes.Count > 0 Then  
        ' Save the dimensions of the source image  
        SourceWidth = Selection.InlineShapes(1).Width  
        SourceHeight = Selection.InlineShapes(1).Height  
    Else  
        MsgBox "No image selected"  
        Exit Sub  
    End If  
  
    ' Initialize FoundMatch  
    FoundMatch = False  
  
    ' Loop through images starting from the next index  
    For i = CurrentIndex + 1 To ActiveDocument.InlineShapes.Count  
        ' Compare the images  
        If SourceWidth = ActiveDocument.InlineShapes(i).Width And SourceHeight = ActiveDocument.InlineShapes(i).Height Then  
            ' Found the next image with the same size, select it  
            ActiveDocument.InlineShapes(i).Select  
            CurrentIndex = i  
            FoundMatch = True  
            ' Ask user if they want to find the next image or stop  
            If MsgBox("Image found. Find next?", vbYesNo) = vbNo Then  
                Exit Sub  
            End If  
        End If  
    Next i  
  
    ' If no match found, loop from the beginning  
    If Not FoundMatch Then  
        For i = 1 To CurrentIndex  
            If SourceWidth = ActiveDocument.InlineShapes(i).Width And SourceHeight = ActiveDocument.InlineShapes(i).Height Then  
                ActiveDocument.InlineShapes(i).Select  
                CurrentIndex = i  
                FoundMatch = True  
                ' Ask user if they want to find the next image or stop  
                If MsgBox("Image found. Find next?", vbYesNo) = vbNo Then  
                    Exit Sub  
                End If  
            End If  
        Next i  
    End If  
  
    ' Check if a match was found  
    If Not FoundMatch Then  
        MsgBox "No next image with the same size found"  
    End If  
End Sub