R
Robin Tucker
Hi there,
As part of my project I need to run through a Word document, replacing
specific items with OLE objects. What I'm doing is generating a report in
..rtf in a different program and then performing the replace with VBA in
Word. The trouble is I am having to delete the image when I find it and
then add a new OLE object, which is slow and doesn't add at the exact
position and with the exact size of the image I'm deleting.
My report generator attaches a "hyperlink" to each image that needs
replacing. Using this facility, I can scan through the Word document and
when I find a hyperlink on an image, I know both the type of object to
insert and the file to insert.
Anyway, here is my function, any hints? :
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
As part of my project I need to run through a Word document, replacing
specific items with OLE objects. What I'm doing is generating a report in
..rtf in a different program and then performing the replace with VBA in
Word. The trouble is I am having to delete the image when I find it and
then add a new OLE object, which is slow and doesn't add at the exact
position and with the exact size of the image I'm deleting.
My report generator attaches a "hyperlink" to each image that needs
replacing. Using this facility, I can scan through the Word document and
when I find a hyperlink on an image, I know both the type of object to
insert and the file to insert.
Anyway, here is my function, any hints? :
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