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.