Search and replace of pictures?

[Robin Tucker]

How can I automate a search and replace of images in my document with some
other inline shape object? I need to scan a generated report and replace
..jpg images with OLEObjects of a certain type. The OLEObject will be given
the same width/height as the .jpg image and should sit in the same position
with the jpg image obviously removed.

Is there any way to do this?


Thanks.

 

[Dave Lett]

Hi Robin,

It depends on how you've inserted the images in your document. If you have
pasted them in, then I don't think you can do what you're looking for. That
is, if it's a "shape", then you can only get VBA to return that its a
msoPicture or one of the other Shape.Type constants. If it's an InlineShape,
then you can only get VBA to return that its a wdInlineShapePicture or one
of the other InlineShape.Type constants.

If you have inserted/linked them, then you can return what you're looking
for. If you have inserted/linked them, let me know and we can work something
out.

Dave

 

[Robin Tucker]

Ok, here is what I've managed to accomplish so far (below), I can iterate
through the set of InlineShapes and determine whether it should be replaced
by looking at its hyperlink (assume for the minute, that my reporting
program doesn't just add the image to the report, it attaches a hyperlink to
the image s well so I can identify the file it should be replaced with). So
wherever in my document I have an inline shape with a hyperlink, I know that
shape should be replaced with the target of the hyperlink (which, in this
case, is an OLEObject, or ".tgw" file).

The problem here is when I AddOLEObject, it adds it at the top of the
document, not **in place** of the image I want to replace. This is
basically all I'm trying to do. I think I'm "AddOLEObject" at some random
place in the document, when really I want to be replacing "theObject" in the
loop with a new one with the same dimensions.


Sub TTX_Replace_Report_Markers()

Dim FileSystem, theShape

Set FileSystem = CreateObject("Scripting.FileSystemObject")

' Iterate through the document objects.

For Each theObject In ActiveDocument.InlineShapes

' Select the object

theObject.Select

' If it has a hyperlink, this is a direct link to our file.

If Not theObject.Hyperlink Is Nothing Then

' Get the link

Dim theLink As String

theLink = theObject.Hyperlink.Address

' Get the extension string

Dim theExtensionPos As Long

theExtensionPos = InStrRev(theLink, ".")

If theExtensionPos > 0 Then

' Get the extension

Dim theExtension

theExtensionPos = Len(theLink) - theExtensionPos

theExtension = Right(theLink, theExtensionPos)

' Quick check to see if the file exists...

If FileSystem.FileExists(theLink) Then

' Determine what type the file is, based on its
extension

Select Case theExtension

Case "jpg"

Set theShape =
ActiveDocument.InlineShapes.AddPicture(FileName:=theLink, _

LinkToFile:=False)

theShape.Width = theObject.Width
theShape.Height = theObject.Height

Case "tgw"

Set theShape =
ActiveDocument.InlineShapes.AddOLEObject(ClassType:="Thermonitor.Image", _

FileName:=theLink, _

LinkToFile:=False, _

DisplayAsIcon:=False)
theShape.Width = theObject.Width
theShape.Height = theObject.Height

Case Else

Set theShape =
ActiveDocument.InlineShapes.AddOLEObject(FileName:=theLink, _

LinkToFile:=False, _

DisplayAsIcon:=False)

theShape.Width = theObject.Width
theShape.Height = theObject.Height

End Select
End If

theObject.Delete
End If
End If
Next
End Sub

 

[Dave Lett]

Hi Robin,

After a _quick_ look at your routine, it's clear that you're not specify the
range in which to place the OLE object. It looks as if you're selecting each
object and expecting the AddOLEObject or AddPicture methods to know that you
want to place it in the current selection. Try this quick fix:

Add the Range parameter the AddOLEObject or AddPicture methods

Range:=Selection.Range

I haven't tested it, but I think it'll place them where you want.

HTH,
Dave

 

[Robin Tucker]

Thats it! Super. I was assuming the "theObject.Select" command was setting
the range.