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

Sinsearach · #1 03-01-2016, 11:20 PM

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.

Code:

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

It works fine except for 2 that issues remain:

1: only replacing 1 instance

2: Sometimes it doesn't even start at the beginning of my document, even with cursor placed there or entire document highlighted (as if it runs "too fast")

1st issue is critical, 2nd is tolerable.

I found this for replacing all text:

Selection.Find.Execute Replace:=wdReplaceAll

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

Help!

-Laters

macropod · #2 03-02-2016, 12:47 AM

Try:

Code:

Sub InsertImages()
Application.ScreenUpdating = False
Dim i As Long
For i = 0 To 9
  With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Forward = True
      .Text = i
      .Replacement.Text = ""
      .Format = False
      .Wrap = wdFindStop
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Execute
    End With
    Do While .Find.Found
      .InlineShapes.AddPicture FileName:="C:\BMP Fonts\Q" & i & ".bmp", _
        LinkToFile:=False, SaveWithDocument:=True
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
Next
Application.ScreenUpdating = True
End Sub

Sinsearach · #3 03-02-2016, 03:09 AM

AWESOME.
And so close now!! spent so many hours on this....
but while your revision checks each instance, it does not remove the original character, it just ADDS my bmps; take a look:

Code:

http://www.imagebam.com/image/105392468865976

Quote:

Originally Posted by macropod

Try:

Code:

Sub InsertImages()
Application.ScreenUpdating = False
Dim i As Long
For i = 0 To 9
  With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Forward = True
      .Text = i
      .Replacement.Text = ""
      .Format = False
      .Wrap = wdFindStop
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Execute
    End With
    Do While .Find.Found
      .InlineShapes.AddPicture FileName:="C:\BMP Fonts\Q" & i & ".bmp", _
        LinkToFile:=False, SaveWithDocument:=True
      .Collapse wdCollapseEnd
      .Find.Execute
    Loop
  End With
Next
Application.ScreenUpdating = True
End Sub

macropod · #4 03-02-2016, 04:16 AM

OK, simply insert:
.Delete
before:
.InlineShapes.AddPicture ...

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Find and Replace fonts?	daroga	Publisher	1	01-22-2016 09:13 PM
Slow "comparison/replace" script	mavCZ	Excel Programming	53	07-27-2014 10:57 AM
replace data from variable with "sub and super script" from excel to word by vba	krishnaoptif	Word VBA	9	06-22-2012 05:08 AM
WORD: Rtf and search-replace (regexp/fonts)	seteshpl	Word	1	09-06-2011 01:35 AM
Macro to Replace Fonts	ballj_35	Word	3	05-10-2011 01:10 AM