Replace text in a word document with an inline image

[jonnyboy]

Hello,

First, I'd like to thank everyone on this forum who has been so helpful so far with a database I've been working on. I'm a bit of a newbie to VB, but I've been learning fast!

I'm trying to write a macro that will find all instances of "G~" in a Word document and replace it with an inline image (probably a small GIF or BMP). Has anyone any ideas how I might start going about this?

Hope you guys can help!

Jon

[jonnyboy]

Alternatively, an approach I have thought of is a loop that will go through the entire document and repeating a 'find' action and inserting the same image at each point. I'm not quite sure how to do this iterative 'find' process though.

Any ideas anyone?

[jonnyboy]

I've managed it... here it is in case anyone needs it!

Sub replaceWithImage(sResponse As String, imageRelativePath As String)
 
    origDocPath = ActiveDocument.Path
    imageFullPath = (origDocPath & "\" & imageRelativePath)
 
    'Application.ScreenUpdating = False
    With Selection
        .HomeKey Unit:=wdStory
 
        With .Find
            .ClearFormatting
            .Text = sResponse
            ' Loop until Word can no longer
            ' find the search string, inserting the specified image at each location
            Do While .Execute
                Selection.MoveRight
                Selection.InlineShapes.AddPicture FileName:=imageFullPath, LinkToFile:=False, SaveWithDocument:=True
            Loop
 
        End With
    End With
 
    'Delete the original text
    With Selection.Find
        .ClearFormatting
        .Text = sResponse
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
    'Application.ScreenUpdating = True
 
End Sub
 

[Killer42]

Sorry to see you didn't get any response on that one, jonnyboy. Thanks very much for posting the answer, though. It'll be helpful to anyone else who comes along with a similar question.

Hope we're more help to you next time.

Keep up the good work - looks as though you're learning fast.