Find, Select & Delete Shapes

[arjopost]

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?

[gmaxey]

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

[macropod]

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

[arjopost]

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

[macropod]

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

[arjopost]

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?

[arjopost]

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.

[gmaxey]

Paul,

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

[macropod]

Fair enough - I'm still using Word 2010.