TrueColor BMP “fonts” in word w/ replace text>bmp script (wont loop)

[Kolonel]

Note: Until few days ago I had never touched VBA, let alone any real programming.

I have read through the top several dozen google returns on 'vba replace text with images' and they either cannot be extended to several dozen searches (94 char bmps) or require a dialog box for each or are far too complex for me to think about fiddling with.

Here I will be using my 94 bmps each 32^2 px as my 'font' to substitute for what I type with this script. This is what I've cobbled together (Im only testing with a few chars 1st)

Problem: It only replaces 1 instance of each character.



Sub InsertImages()

With ActiveDocument
Selection.Find.ClearFormatting

With Selection.Find
.Forward = True
.Text = "0"
.Replacement.Text = ""
.Format = False
.MatchCase = False
.MatchWholeWord = Flase
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

If Selection.Find.Execute Then
Selection.InlineShapes.AddPicture FileName:= _
"C:\BMP Fonts\Q0.bmp", LinkToFile:=False, _
SaveWithDocument:=True

ElseIf Selection.Find.Wrap = wdFindContinue Then
End If

Selection.Find.ClearFormatting

With Selection.Find
.Forward = True
.Text = "1"
.Replacement.Text = ""
.Format = False
.MatchCase = False
.MatchWholeWord = Flase
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

If Selection.Find.Execute Then
Selection.InlineShapes.AddPicture FileName:= _
"C:\BMP Fonts\Q1.bmp", LinkToFile:=False, _
SaveWithDocument:=True

ElseIf Selection.Find.Wrap = wdFindContinue Then
End If

End With

End Sub




I found this for replacing all text:


Selection.Find.Execute Replace:=wdReplaceAll

but it ONLY works for with substituting text, not images.

Help!

-Laters

[gmaxey]

See if this works:


Sub InsertImages()
Dim lngIndex As Long
Dim oRng As Range
For lngIndex = 0 To 94
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Forward = True
.Text = "0"
While .Execute
oRng.InlineShapes.AddPicture FileName:= _
"C:\BMP Fonts\Q" & lngIndex & ".bmp", LinkToFile:=False, _
SaveWithDocument:=True
oRng.Collapse wdCollapseEnd
Wend
End With
Next lngIndex
lbl_Exit:
Exit Sub
End Sub