Is there a way to programatically locate all images in a document?

H

Henry Stock

Apparently the search function using the graphics option skips over some
images. I think someone told me there is a difference between inline images
and ones that are floating. My tasks are as follows:

1. I would like to build a macro that will locate each image in the
document and select it regardless of which type it is.

2. Then I want to build a second macro that will left align selected images
and set wordwrap to top and bottom only, adjusting the margins abit so that
text is not too close to the picture.

3. Finally for many images, there is a caption of sorts. I don't know if it
was created as a caption. I just know that the style is listed as
"OP-FigureHeader". I want to ensure that this text, if it exists, is
directly above the image.

The document is close to 300 pages long and there are many images, so I am
hoping to automate this as much as possible.

At this point I have only create one macro mostly through recording and it
is not perfect. the text below implents task 2. I welcome any suggestions

Sub LeftAlign()
'
' Assumes the image is already selected
' Removed references to the image shape and size,
' Not sure which other commands are not necessary

Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.PictureFormat.Brightness = 0.5
Selection.ShapeRange.PictureFormat.Contrast = 0.5
Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
Selection.ShapeRange.PictureFormat.CropLeft = 0#
Selection.ShapeRange.PictureFormat.CropRight = 0#
Selection.ShapeRange.PictureFormat.CropTop = 0#
Selection.ShapeRange.PictureFormat.CropBottom = 0#
' The first time I run this macro there seems to be a problem with one of
' the two following commands that forces me into debug, but I can then
complete the macro by continuing.
Selection.ShapeRange.RelativeHorizontalPosition = _
wdRelativeHorizontalPositionColumn
Selection.ShapeRange.RelativeVerticalPosition = _
wdRelativeVerticalPositionLine
Selection.ShapeRange.Left = wdShapeLeft
Selection.ShapeRange.Top = InchesToPoints(0.1)
Selection.ShapeRange.LockAnchor = False
Selection.ShapeRange.LayoutInCell = True
Selection.ShapeRange.WrapFormat.AllowOverlap = True
Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
Selection.ShapeRange.WrapFormat.DistanceTop = InchesToPoints(0.2)
Selection.ShapeRange.WrapFormat.DistanceBottom = InchesToPoints(0.2)
Selection.ShapeRange.WrapFormat.DistanceLeft = InchesToPoints(0.1)
Selection.ShapeRange.WrapFormat.DistanceRight = InchesToPoints(0.2)
Selection.ShapeRange.WrapFormat.Type = wdWrapTopBottom
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top