VBA: Remove Pictures, Graphics, Shape At Once

Susanto3311
3StarLounger
Posts: 240
Joined: 17 Feb 2022, 05:16

VBA: Remove Pictures, Graphics, Shape At Once

Post by Susanto3311 »

hi all..
i'm looking for a vba code to remove /delete all pictures or graphics or shapes, at once from MS Word
the below code not work fully

Code: Select all

Sub Remover()
    Dim i As Integer

    With ActiveDocument
        For i = 1 To .InlineShapes.Count
            .InlineShapes(i).ConvertToShape
        Next i

        .Shapes.SelectAll
        Selection.Delete
    End With
End Sub
i hope someone give me great code..
susan

User avatar
macropod
4StarLounger
Posts: 508
Joined: 17 Dec 2010, 03:14

Re: VBA: Remove Pictures, Graphics, Shape At Once

Post by macropod »

For example:

Code: Select all

Sub Remover()
Application.ScreenUpdating = False
With ActiveDocument
  While .InlineShapes.Count > 0
    .InlineShapes(1).Delete
  Wend
  While .Shapes.Count > 0
    .Shapes(1).Delete
  Wend
End With
Application.ScreenUpdating = True
End Sub
Paul Edstein
[Fmr MS MVP - Word]

Susanto3311
3StarLounger
Posts: 240
Joined: 17 Feb 2022, 05:16

Re: VBA: Remove Pictures, Graphics, Shape At Once

Post by Susanto3311 »

hi Paul,,
thanks but your code for picture formats like jpg.jpeg, png not work

User avatar
macropod
4StarLounger
Posts: 508
Joined: 17 Dec 2010, 03:14

Re: VBA: Remove Pictures, Graphics, Shape At Once

Post by macropod »

Picture formats are irrelevant - what matters is whether they are stored as inline shapes or floating shapes. The code works just fine for me with .bmp, .gif, .tif, .jpg, .jpeg, & .png files inserted as inline shapes or floating shapes.
Paul Edstein
[Fmr MS MVP - Word]

Susanto3311
3StarLounger
Posts: 240
Joined: 17 Feb 2022, 05:16

Re: VBA: Remove Pictures, Graphics, Shape At Once

Post by Susanto3311 »

macropod wrote:
22 Jun 2022, 04:53
For example:

Code: Select all

Sub Remover()
Application.ScreenUpdating = False
With ActiveDocument
  While .InlineShapes.Count > 0
    .InlineShapes(1).Delete
  Wend
  While .Shapes.Count > 0
    .Shapes(1).Delete
  Wend
End With
Application.ScreenUpdating = True
End Sub
hi Paul, thanks a lot for this code. working with properly.