Rip this code apart and tell me what I've done wrong...

[dvdastor]

Hi All,

In the code below, I am attempting to do multiple finds and replaces
for font formatting within a Range. I am successful in finding and
replacing the first occurrence, but anything after that fails. My
range shrinks somehow and I cannot seem to figure out why or how. I
have tried using the Duplicate method (not in the code below), but I
may have been doing this incorrectly. Can you please take a look and
make any suggestions? Thanks!!!!!!!!

----------------------------

Private Function ReturnAsString(ByVal inputRng As Word.Range) As String

Dim iParaCount As Integer
Dim myPara As Word.Paragraph
iParaCount = inputRng.Paragraphs.Count

For iParaCount = inputRng.Paragraphs.Count To 1 Step -1
myPara = inputRng.Paragraphs(iParaCount)
'myPara.Select 'debug info
If Len(myPara.Range.Text) <= 1 Then myPara.Range.Delete()
Next

If inputRng.Characters.First.Text = vbCr Then
inputRng.MoveStart(Word.WdUnits.wdCharacter, 1)
End If
If inputRng.Characters.Last.Text = vbCr Then
inputRng.MoveEnd(Word.WdUnits.wdCharacter, -1)
End If

With inputRng.Find
.ClearFormatting()
.Font.Bold = 1
.Replacement.ClearFormatting()
.Replacement.Font.Bold = 0
.Execute(findtext:="", ReplaceWith:="<b>^&</b>",
Format:=True, Replace:=Word.WdReplace.wdReplaceAll)
End With


With inputRng.Find
.ClearFormatting()
.Font.Italic = 1
.Replacement.ClearFormatting()
.Replacement.Font.Italic = 0
.Execute(findtext:="", ReplaceWith:="<i>^&</i>",
Format:=True, Replace:=Word.WdReplace.wdReplaceAll)
End With


With inputRng.Find
.ClearFormatting()
.Font.Underline = Word.WdUnderline.wdUnderlineSingle
.Replacement.ClearFormatting()
.Replacement.Font.Underline = 0
.Execute(findtext:="", ReplaceWith:="<u>^&</u>",
Format:=True, Replace:=Word.WdReplace.wdReplaceAll)
End With

With inputRng.Find
.ClearFormatting()
.Font.Name = "Tahoma"
.Replacement.ClearFormatting()
.Execute(findtext:="", ReplaceWith:="<font
face=&quot;Tahoma&quot;>^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


With inputRng.Find
.ClearFormatting()
.Font.Name = "Courier"
.Replacement.ClearFormatting()
.Execute(findtext:="", ReplaceWith:="<font
face=&quot;Courier&quot;>^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


With inputRng.Find
.ClearFormatting()
.Font.Name = "Courier New"
.Replacement.ClearFormatting()
.Execute(findtext:="", ReplaceWith:="<font
face=&quot;Courier New&quot;>^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


With inputRng.Find
.ClearFormatting()
.Font.Name = "Verdana"
.Replacement.ClearFormatting()
.Execute(findtext:="", ReplaceWith:="<font
face=&quot;Verdana&quot;>^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With inputRng.Find
.ClearFormatting()
.Font.Name = "Times New Roman"
.Replacement.ClearFormatting()
.Execute(findtext:="", ReplaceWith:="<font face=&quot;Times
New Roman&quot;>^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With inputRng.Find
.ClearFormatting()
.Font.Name = "Arial"
.Replacement.ClearFormatting()
.Execute(findtext:="", ReplaceWith:="<font
face=&quot;Arial&quot;>^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With inputRng.Find
.ClearFormatting()
.Font.Size = 8
.Replacement.ClearFormatting()
.Execute(findtext:="", ReplaceWith:="<font
size=&quot;1&quot;>^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With inputRng.Find
.ClearFormatting()
.Font.Size = 10
.Replacement.ClearFormatting()
.Execute(findtext:="", ReplaceWith:="<font
size=&quot;2&quot;>^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With

With inputRng.Find
.ClearFormatting()
.Font.Size = 12
.Replacement.ClearFormatting()
.Execute(findtext:="", ReplaceWith:="<font
size=&quot;3&quot;>^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll,
Wrap:=Word.WdFindWrap.wdFindContinue)
End With


With inputRng.Find
.ClearFormatting()
.Font.Size = 16
.Replacement.ClearFormatting()
.Execute(findtext:="", ReplaceWith:="<font
size=&quot;4&quot;>^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


With inputRng.Find
.ClearFormatting()
.Font.Size = 18
.Execute(findtext:="", ReplaceWith:="<font
size=&quot;5&quot;>^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


With inputRng.Find
.ClearFormatting()
.Font.Size = 24
.Replacement.ClearFormatting()
.Execute(findtext:="", ReplaceWith:="<font
size=&quot;6&quot;>^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


With inputRng.Find
.ClearFormatting()
.Font.Size = 32
.Replacement.ClearFormatting()
.Execute(findtext:="", ReplaceWith:="<font
size=&quot;7&quot;>^&</font>", Format:=True,
Replace:=Word.WdReplace.wdReplaceAll)
End With


Return inputRng.Text
End Function

 

[Helmut Weber]

Hi,
to the best of my knowledge,

maybe an additional .wrap = wdfindstop might help.

Plus something more theoretical:
You are doing something to a range.
A range is defined as a part of a document,
starting from character x, ending with character y.
If you add something inside the range,
the range itself doesn't change.
But what you have added might move the scope
of what you want to process outside the range.

And, as I've been doing Word to QuarkXpress conversion
for 10 years, the first thing I'd do,
is deformatting paragraph marks.

That is search for paragraph marks
and set italic, bold, underline, etc. to false,
which will releave you of constructions like movestart and moveend.


HTH


Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/