Vba word shapes delete

• Remove From My Forums

• Question

• I’m trying to use the following code to delete all shapes in a Word document (2007):

  Sub DeleteAllShapes()
  Dim shp As Word.Shape
  For Each shp In ActiveDocument.Shapes
      shp.Delete
  Next
  End Sub

  The problem is that it doesn’t delete all the shapes on the first pass; in fact it deletes half of them. On the next pass it deletes another 50%, and so on. Obviously it’s skipping a shape each time one gets deleted.

  Is there a way to use the collection so that all the shapes get deleted?

SubRemoveShapes()

    Dim oShape AsShape

    Do

        For EachoShape In ActiveDocument.Shapes

           ‘ Delete the shape

            oShape.Delete

        NextoShape

    Loop UntilActiveDocument.Shapes.Count = 0

    Set oShape = Nothing

End Sub

• 
• Forum
• VBA Code & Other Help
• Word Help
• Find, Select & Delete Shapes

1. 02-17-2018, 07:32 AM

   
   

   #1

   Find, Select & Delete Shapes
   

   Hi,

   I have a large Word document with a lot of WordArt shapes. I would like to find & delete them using a macro.
   Perhaps with a dialog box with OK and Cancel so I can decide what to do.

   In Word the WordArt shapes have names like «WordArt 12»

   It’s been a long long time I’ve used VBA. I think it must be possible to use a concatenated string:

   dim myWordArt = "WordArt" & number

   and then somehow find, select & delete the WordArt shapes.

   Anyone?

   Last edited by Paul_Hossler; 02-17-2018 at 10:23 AM.

   Reason: replaced vba tags with CODE tags

   ---

2. 02-17-2018, 09:53 AM

   
   

   #2

   Provided that they are anchored to the main text storyrange, something like this may do. Otherwise you will have to loop through some the other storyranges:

   Sub ScratchMacro()
   'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 2/17/2018
   Dim oShp As Shape
   Dim lngIndex As Long
     For lngIndex = ActiveDocument.Shapes.Count To 1 Step -1
       Set oShp = ActiveDocument.Shapes(lngIndex)
       oShp.Select
       Application.ScreenRefresh
       If MsgBox("Do you want to delete this shape?", vbYesNo, "DELETE") = vbYes Then
         oShp.Delete
       End If
     Next lngIndex
   lbl_Exit:
     Exit Sub
   End Sub

   ---

3. 02-17-2018, 03:53 PM

   
   

   #3

   Since WordArt objects are ordinarily inserted in-line, you may need something closer to:

   Sub Demo()
   Dim i As Long
   With ActiveDocument
     For i = .InlineShapes.Count To 1 Step -1
       With .InlineShapes(i)
         If .Type = wdInlineShapePicture Then
           .Select
           If MsgBox("Delete this shape?", vbYesNo, "DELETE") = vbYes Then .Delete
         End If
       End With
     Next
   End With
   End Sub

   Cheers
   Paul Edstein
   [Fmr MS MVP — Word]

   ---

4. 02-18-2018, 04:15 AM

   
   

   #4

   Thanks guys but how can I select only those shapes that have a name like «WordArt 842» (and show the name for confirmation of delete)?
   Something like this :

   Sub Demo()
   Dim i As Long
   Dim myString as String
   With ActiveDocument
   	For i = .InlineShapes.Count To 1 Step -1
   		With .InlineShapes(i)
   			If .Type = wdInlineShapePicture Then
   				myString = substring(wdInlineShapePicture.name,1,7)
   				if myString = "WordArt" Then
   					.Select
   					If MsgBox("Delete " & wdInlineShapePicture.name & " ?", vbYesNo, "DELETE") = vbYes Then .Delete
   				End If
   			End If
   		End With
   	Next
   End With
   End Sub

   Last edited by arjopost; 02-18-2018 at 04:21 AM.

   Reason: still typing code

   ---

5. 02-18-2018, 04:34 AM

   
   

   #5

   InlineShapes don’t have a name property. If your WordArt objects have names, that suggests someone has converted them to a wrapped format. In that case you might use:

   Sub Demo()
   Dim i As Long
   With ActiveDocument
     For i = .Shapes.Count To 1 Step -1
       With .Shapes(i)
         If .Type = msoTextEffect Then
           If .Name Like "WordArt*" Then
             .Select
             If MsgBox("Delete this shape? " & .Name, vbYesNo, "DELETE") = vbYes Then .Delete
           End If
         End If
       End With
     Next
   End With
   End Sub

   Cheers
   Paul Edstein
   [Fmr MS MVP — Word]

   ---

6. 02-18-2018, 04:57 AM

   
   

   #6

   Thanks Paul this it works just fine. I have another issue that is in line with this solution; I have my name in several textareas in the same document. So not in a WordArt object but in a textarea. They have names like «Tekstvak 622». Now I would like to search for my name «Arjo» that is inside the content of the textarea, and then select & delete the textareas it is in. Something with .Parent maybe?

   ---

7. 02-18-2018, 06:44 AM

   
   

   #7

   I finally did some research myself

   Sub FindDeleteTextBox()
   
   dim i as Long
   dim sTemp as String
   
   With ActiveDocument
       For i = .Shapes.Count To 1 Step -1
           With .Shapes(i)
               If .Type = msoTextBox Then
                   .Select
                   Selection.ShapeRange.TextFrame.TextRange.Select
                   sTemp = Selection.Text
                   
                   If sTemp Like "*Arjo*" Then
                       If MsgBox("Delete this textbox? " & .Name, vbYesNo, "DELETE") = vbYes Then .Delete
                   End If
   
               End If
           End With
       Next
    End With
   End Sub

   Thanks for all the help! My problems are solved so this thread can be closed.

   Last edited by arjopost; 02-18-2018 at 07:01 AM.

   ---

8. 02-18-2018, 07:42 AM

   
   

   #8

   Paul,

   Since Word 2010, WordArt is inserted as floating text. That is why I suggested to loop through the shapes initially.

   ---

9. 02-18-2018, 12:42 PM

   
   

   #9

   Fair enough — I’m still using Word 2010.

   Cheers
   Paul Edstein
   [Fmr MS MVP — Word]

   ---

Tags for this Thread