Replacing string with inline image file

[maria6439]

Hi, everybody!
I confess that I don't know anything about VBA (but I excell in using macros in Word) and I need a few lines of code that will solve a problem for me. Here it is:

I have a few word files that in the middle of the text have strings like this <<path/filename.eps>>. What I need is something that will loop through the text and replaces the strings with the mentioned graphic file.

The graphic files are equations made with MathType (eps files) and exported to a folder in the hard drive using MathType Export Equations command.

Best regards and thank you in advance.

Maria

[macropod]

Hi Maria,

I'm feeling lazy today, so I've just adapted some code I'd previously written for an entirely different project. What it does is it converts a string to a Word field. In this case, I've adapted it to turn your strings into Word INCLUDEPICTURE fields. That means that, the images remain linked to the source so that, if you change them, the images in the document will update.
Sub MakePics()
' Converts image paths & filenames bound by << and >> into INCLUDEPICTURE fields
' To do the conversion, simply paste the image paths & filenames bound by << and >>
' into your document, select them or even the whole document and run the macro.
Dim RngFld As Range, RngTmp As Range, oFld As Field, StrTmp As String, TrkStatus As Boolean
Const Msg1 = "Select the text to convert and try again."
Const Msg2 = "There are no field strings in the selected range."
Const Msg3 = "Unmatched field brace pairs in the selected range."
Const Title1 = "Error!"
If Selection.Type <> wdSelectionNormal Then
MsgBox Msg1, vbExclamation + vbOKOnly, Title1
Exit Sub
End If
If InStr(1, Selection.Text, "<<") = 0 Or _
InStr(1, Selection.Text, ">>") = 0 Then
MsgBox Msg2, vbCritical + vbOKOnly, Title1
End If
If Len(Replace(Selection.Text, "<<", vbNullString)) <> _
Len(Replace(Selection.Text, ">>", vbNullString)) Then
MsgBox Msg3, vbCritical + vbOKOnly, Title1
Exit Sub
End If
' Store current Track Changes status, then switch off
With ActiveDocument
TrkStatus = .TrackRevisions
.TrackRevisions = False
End With
' Turn Off Screen Updating
Application.ScreenUpdating = False
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
Set RngFld = Selection.Range
With RngFld
.End = .End + 1
Do While InStr(1, .Text, "<<") > 0
Set RngTmp = ActiveDocument.Range(Start:=.Start + InStr(.Text, "<<") - 1, _
End:=.Start + InStr(.Text, ">>"))
With RngTmp
Do While Len(Replace(.Text, "<<", vbNullString)) <> _
Len(Replace(.Text, ">>", vbNullString))
.End = .End + 1
If .Characters.Last.Text <> ">>" Then .MoveEndUntil cset:=">>", _
Count:=Len(ActiveDocument.Range(.End, RngFld.End))
Loop
.Characters.First = vbNullString
.Characters.Last = vbNullString
StrTmp = .Text
Set oFld = ActiveDocument.Fields.Add(Range:=RngTmp, _
Type:=wdFieldEmpty, Text:="", PreserveFormatting:=False)
oFld.Code.Text = "INCLUDEPICTURE " & _
Replace(Replace(Replace(Replace(StrTmp, "/", "//"), "\", "//"), ">", Chr(34)), "<", Chr(34))
.Fields.Update
End With
Loop
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
.End = .End - 1
End With
Set RngTmp = Nothing: Set RngFld = Nothing: Set oFld = Nothing
' Restore original Track Changes status
ActiveDocument.TrackRevisions = TrkStatus
' Restore Screen Updating
Application.ScreenUpdating = True
End Sub
As originally written, the code was designed for processing nested Word fields, so in theory it's capable of far more than you're asking for. Taking out that extra functionality is more trouble than it's worth, though.

[maria6439]

Hi Macropod,
Thank you for your quick reply. I haven't tested your code yet because I will be out of the office for a few days. But as soon as possible I will give you feed back about you code.
Cheers
Maria

[maria6439]

Hi, Macropod

After one week out of the office I finally had enough time to test your code and it works only if there is only one equation in the selected text. If there are more than one, it replaces the first and delete the rest of the text and all others placeholders included in that paragraph.

Can you fix it for me:help ? Thank you in advance.

Maria

[gmaxey]

I can't explain why Paul's code performs as it does. He will likely be back to do so. You can try:

Sub MakePics()
'Converts image paths & filenames bound by << and >> into INCLUDEPICTURE fields
'To do the conversion, simply paste the image paths & filenames bound by << and >>
'into your document, select them or even the whole document and run the macro.
Dim RngFld As Range, RngTmp As Range, oFld As Field, StrTmp As String, TrkStatus As Boolean
Const Msg1 = "Select the text to convert and try again."
Const Msg2 = "There are no field strings in the selected range."
Const Msg3 = "Unmatched field brace pairs in the selected range."
Const Title1 = "Error!"
Select Case True
Case Selection.Type <> wdSelectionNormal
MsgBox Msg1, vbExclamation + vbOKOnly, Title1
Exit Sub
Case InStr(1, Selection.Text, "<<") = 0 Or InStr(1, Selection.Text, ">>") = 0
MsgBox Msg2, vbCritical + vbOKOnly, Title1
Exit Sub
Case Len(Replace(Selection.Text, "<<", vbNullString)) <> Len(Replace(Selection.Text, ">>", vbNullString))
MsgBox Msg3, vbCritical + vbOKOnly, Title1
Exit Sub
End Select
'Store current Track Changes status, then switch off
With ActiveDocument
TrkStatus = .TrackRevisions
.TrackRevisions = False
End With
'Turn Off Screen Updating
Application.ScreenUpdating = False
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
Set RngFld = Selection.Range
With RngFld.Find
.Text = "\<\<*\>\>"
.MatchWildcards = True
While .Execute
With RngFld
.Characters.First = vbNullString
.Characters.Last = vbNullString
.Characters.First = vbNullString
.Characters.Last = vbNullString
StrTmp = .Text
Set oFld = ActiveDocument.Fields.Add(Range:=RngFld, _
Type:=wdFieldEmpty, Text:="", PreserveFormatting:=False)
oFld.Code.Text = "INCLUDEPICTURE " & _
Replace(Replace(Replace(Replace(StrTmp, "/", "//"), "\", "//"), ">", Chr(34)), "<", Chr(34))
.Fields.Update
End With
Wend
End With
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
Set RngTmp = Nothing: Set oFld = Nothing
'Restore original Track Changes status
ActiveDocument.TrackRevisions = TrkStatus
'Restore Screen Updating
Application.ScreenUpdating = True
End Sub

[maria6439]

Thank you very much. That solved the problem.

This forum has a lot of nice guys!!!


Maria

[fhimage]

thank you for the above codes , this forum is so good