Searching for Floating Graphics

I couldn’t resist fiddling with the macro to add improvements and make it a bit more bulletproof. The following macro will find the next shape even if there are several shapes with the same anchor point.

An anchor contains a list of shapes but the list is not visible nor is it directly accessible in VBA. However with a bit of trickery it is possible to determine the position in the list of a particular shape and advance to the next shape in the list. The order in the list is in the reverse order that the shapes were attached to that anchor.

The macro will find groups and canvases but not the individual shapes within them. If you want to search for shapes in other story ranges such as headers or footers then place the cursor in the header or footer and run the macro. This can uncover hard to find shapes and textboxes that are anchored in headers or footers but are offset into the text body.

By altering a few statements a second macro can be created that will search for previous rather than next shapes.

Sub FindNextShape2()
Dim aAnchor As Range
Dim aShape As Shape
Dim k As Long
Dim j As Long
Dim aShapeName As String
Dim aStory As Range
If Application.Version > 14 Then
MsgBox "This macro will only run in Word 2010 or higher"
Exit Sub
End If
If Val(ActiveDocument.CompatibilityMode) < 14 Then
MsgBox "Warning. Document was created in a version of Word prior to 2010"
End If

aShapeName = "$&$&"
If Selection.ShapeRange.Count > 0 Then
' Check if there are several at the same anchor
Set aShape = Selection.ShapeRange(1)
aShapeName = aShape.Name
Set aAnchor = aShape.Anchor
aAnchor.MoveStart unit:=wdCharacter, Count:=-1
aAnchor.MoveEnd unit:=wdCharacter, Count:=1
k = aAnchor.ShapeRange.Count ' k=number of shapes at anchor

Set aAnchor = aShape.Anchor
aAnchor.MoveStart unit:=wdCharacter, Count:=-1
j = aAnchor.ShapeRange.Count ' j= posn of shape at anchor

If j < k Then
Set aAnchor = aShape.Anchor
aAnchor.MoveStart unit:=wdCharacter, Count:=-1
aAnchor.MoveEnd unit:=wdCharacter, Count:=1
Set aShape = aAnchor.ShapeRange(j + 1)
Selection.Collapse
aShape.Select
Exit Sub
Else ' current shape is the last at the anchor
Selection.ShapeRange(1).Anchor.Select
Selection.MoveStart unit:=wdCharacter
End If
End If

Application.Browser.Target = wdBrowseGraphic
Application.Browser.Next
Selection.MoveStart unit:=wdCharacter, Count:=-1
Selection.MoveEnd unit:=wdCharacter, Count:=1
If Selection.Range.ShapeRange.Count < 1 Then
MsgBox "No shapes beyond this point"
Exit Sub
End If
Set aShape = Selection.Range.ShapeRange(1)
Selection.Collapse
aShape.Select
If aShapeName = aShape.Name Then
MsgBox "No more shapes after this one"
End If
End Sub

The macro instructions to select shapes can be quite complex with the result that a macro to cover all possibilities will be large and complex.

However, the following is a simple macro that will find the next shape from the current cursor position. Its shortcomings are that if there is more than one shape with the same anchor position then only the first is found, and although shapes can be in story types such as headers and footers only the main story (ie the document body) is searched.


Sub FindNextShape()
Dim aShape As Shape
If Selection.ShapeRange.Count > 0 Then
Selection.ShapeRange(1).Anchor.Select
Selection.MoveStart unit:=wdCharacter
End If
Application.Browser.Target = wdBrowseGraphic
Application.Browser.Next
Selection.MoveStart unit:=wdCharacter, Count:=-1
Selection.MoveEnd unit:=wdCharacter, Count:=1
Set aShape = Selection.Range.ShapeRange(1)
Selection.Collapse
aShape.Select
End Sub

Ken, thanks for that macro -- when documents are graphic-heavy, this is indeed a more reliable way to find a specific graphic (especially useful for finding non-OCR'd characters/words in a PDF to Word conversion!).

The disadvantage of the FindFigs macro is that it finds graphics in the order that they were inserted into the document, not the order in which they appear.

Browse by graphic will find the next (or previous) graphic in the order that they appear in the document. (actually, it is the order that the anchors appear in the document)

Browse by graphic places the cursor at the graphic's anchor without selecting the graphic and since the graphic could be offset some distance from its anchor it may not be obvious which graphic has been found. If you extend the selection to the whole the paragraph then the graphic will be highlighted but if more than one graphic is anchored at the same point then they will all be highlighted.

It can be confusing when there are multiple graphics with the same anchor point because clicking the browse button again may not move the cursor but it is in fact progressing to the next graphic.

The VBA code for finding and selecting graphics using browser is:

Application.Browser.Target = wdBrowseGraphic
Application.Browser.Next
Selection.MoveStart unit:=wdCharacter, Count:=-1
Selection.MoveEnd unit:=wdCharacter, Count:=2
Selection.Range.ShapeRange(1).Select

or,
Application.Browser.Previous

Browse by graphic can give unexpected results if the document and its graphics were created in a Word version earlier than 2010.

Browse by Object for graphics (below the vertical scroll bar) finds the anchor paragraph for floating graphics, so if you follow best practice and anchor your graphics where they are supposed to be and then lock them, this tool is a very easy way to find them.

But locking a graphic is a lot of steps in 2010, so here is a simple little macro I added to my toolbar for that purpose -- hope that saves you as much time as it does for me!

Sub ToggleShapeAnchor()
If Selection.Type = wdSelectionShape Then
For Each Shape In Selection.ShapeRange
Shape.LockAnchor = Not Shape.LockAnchor
Next
End If
End Sub