View Single Post
 
Old 11-20-2019, 05:02 PM
ads747 ads747 is offline Mac OS X Office 2016 for Mac
Novice
 
Join Date: Nov 2019
Posts: 1
ads747 is on a distinguished road
Default Delete identical images

Hi all,

I'm trying to automate the process of deleting old (dated) icons and images from a word document. The same images are repeated throughout the document. I've written this macro to delete images 'identical' to the selected. As the images do not seem to have names, I've been finding images of the same dimensions (imperfect I know). Is there a better way to do this or a way to find a unique identifier for identical shapes (even if resized)? A number of the icons have been slightly resized so I have to run this macro multiple times.

Heres what I've got:

Code:
Sub DeleteSelectedPicture()
Dim Shp As Shape, iShp As InlineShape
Dim DC As Integer, SHeight As Variant, SWidth As Variant
DC = 0

If Selection.InlineShapes.Count = 1 Then
SHeight = Selection.InlineShapes(1).Height
SWidth = Selection.InlineShapes(1).Width
End If
If Selection.ShapeRange.Count = 1 Then
SHeight = Selection.ShapeRange(1).Height
SWidth = Selection.ShapeRange(1).Width
End If

With ActiveDocument
  For Each iShp In .InlineShapes
    If iShp.Height = SHeight And iShp.Width = SWidth Then
    iShp.Delete
    DC = DC + 1
    End If
  Next
  
  For Each Shp In .Shapes
    If Shp.Height = SHeight And Shp.Width = SWidth Then
    Shp.Delete
    DC = DC + 1
    End If
  Next
  MsgBox DC & " pictures deleted."
End With
End Sub
Reply With Quote