Iterating through all AutoShapes in Document

[ldchip]

I'd like to request some help constructing a code snippet which will iterate
through all AutoShape objects in a document, setting the
Shape.Fill.UserPicture fn property with a filename parsed from the paragraph
immediately preceding the AutoShape object. For example, this pattern
repeats randomly throughout the document -

=piclink=Path\imageName.jpg=
followed by a DrawingCanvas or Frame, containing one AutoShape object.

Either each instance of the tag "=piclink=" can be found, parsed for fn, and
knowing the AutoShape is the next line down. Or is it better to iterate
through all AutoShape object (perhaps ShapeRange array ? ) , knowing the fn
can be parsed from the paragraph preceding the AutoShape ?

I'm a novice VBA coder, like most, I read VBA much better than I can write
it

Any help with any snippet of code to accomplish this is much appreciated.

thanks,
Lou

 

[DaveLett]

Hi,
I think you're looking for something like the following:
Dim oRng As Range
Dim sPath As String
Dim lShapes As Long

With Selection
.HomeKey Unit:=wdStory
With .Find
.text = "=piclink=*="
.MatchWildcards = True
Do While .Execute
sPath = Replace(Selection.text, "=", "")
sPath = Replace(sPath, "piclink", "")
Set oRng = Selection.Range
oRng.Start = ActiveDocument.Range.Start
lShapes = oRng.ShapeRange.Count + 1
ActiveDocument.Shapes(lShapes).Fill.UserPicture PictureFile:=sPath
Loop
End With
End With

I gave it a quick test, and it was working in my environment.

HTH,
Dave

 

[ldchip]

Dave,

well done! Your code suggestion helped me complete the task. I made some
minor adjustments to the code and doc layout (pre-macro processing) as noted
below.

fyi for future readers - the doc is built using mail-merge and fields on a
custom template, then I run the macro to fill the AutoShapes with the
pictures. This method provides a solution for an otherwise high dollar
program to build small or large picture directories for clubs, churches, any
membership organization with a need for a picture directory.

code and doc layout changes...

* I removed the Canvas object, 1 per AutoShape, from the doc. This allowed
traversing the Shapes collection or ShapeRange to just land on AutoShape
object.

* I placed the picture file name string after the AutoShape, instead of
before it. Given the logic to set the oRng.Start to top of document, the
last Shape in the range needed to be the target of the picture fill.

* I change the lines...
lShapes = oRng.ShapeRange.Count + 1
ActiveDocument.Shapes(lShapes).Fill.UserPicture PictureFile:=sPath
to...
lShapes = oRng.ShapeRange.Count
oRng.ShapeRange(lShapes).Fill.UserPicture PictureFile:=sPath

* added code to delete the picture filename string from the doc, cleanup.

Lou