A macro to fix empty boxes, wrong symbols in imported WP files (ALMOST READY)

[Edward Mendelson]

Thanks again to Helmut Weber, I *almost* have a macro that solves this
common problem:

A user creates a file in WordPerfect (on a system that has the WP
TypographicSymbols and other WP fonts installed); the same user opens the
file in Word and saves it in Word format. The user then sends the Word file
to another user who does NOT have the WP TypographicSymbols font installed;
The other user opens the Word file and sees A and @ instead of typographic
quotation marks, C instead of a dash, etc. (There was a plea for help about
this kind of problem in microsoft.public.word.conversions a few days ago.)

As far as I can tell, up to now there has been no easy solution to this, but
here is how it can be done.

First, save the problem file in Word for Windows 2.0 format (Word 2003, as
shipped, can not save documents in WinWord 2.0 format, but if you copy
WNWRD232.CNV from a system with Word 2002 to the ...\TextConv folder in a
system with Word 2003, and then restart Word - or it may be necessary to
restart Windows - Word 2003 can save files in WinWord 2.0 format). Then
close the document on screen and immediately re-open it. (All this can be
done with a macro.)

Now use Alt-F9 or ActiveWindow.View.ShowFieldCodes = True to make field
codes visible (and display them as shaded with
ActiveWindow.View.FieldShading = wdFieldShadingAlways).
All the "wrong characters" will now be revealed to be field codes that look
like this (the example is the em-dash character):

{symbol 64 \f "WP TypographicSymbols" \s 12}

64 is the symbol number in the WP TypographicSymbols font and 12 is the size
(which we are going to ignore for the sake of sanity).

Now, using Helmut's code, here is a macro that will replace all instances of
one wrong character with the matching native Windows character. The trouble
is that the macro as written only replaces all instances of one character
and then quits. I obviously (at least I *think* it's obvious) need a For
Each ... Next loop (as indicated by comments), but I can't figure out
exactly what the For Each ... Next code should look like

(I also need to enclose the routines in ones that will loop through all
document ranges, but that shouldn't be too difficult, using code by Doug
Robbins and Peter Hewett.)

Here is the code

Sub FixWrongSymbols003()
' Engine and all intelligent parts by Helmut Weber
Dim rDcm As Range
Dim rFnd As Range
Set rDcm = ActiveDocument.Range
Dim iSym As Long ' symbol number
Dim fSym As String ' font name
Dim rChr As String ' replacement character number
Resetsearch

'''' For Each WHAT needed here?

With rDcm.Find
.Text = "^19symbol"
While .Execute
Set rFnd = rDcm.Duplicate
With rFnd.Find
'.Text = " [0-9]{1;}" ' German
.Text = " [0-9]{1,}" ' English
.MatchWildcards = True
If .Execute Then
iSym = Trim(rFnd.Text) ' symbol number
'msgBox (iSym) ' var 1
End If
End With
Set rFnd = rDcm.Duplicate
With rFnd.Find
.Text = "^34*^34"
.MatchWildcards = True
If .Execute Then
fSym = rFnd.Text ' font name
'msgBox fSym 'var 2
End If
End With

Select Case fSym
Case Chr(34) & "WP TypographicSymbols" & Chr(34)
Select Case iSym
Case 64: rChr = """" ' closing typographic quotation mark
Case 65: rChr = """" ' open typographic quotation mark
Case 66: rChr = ChrW(&H2013) ' en dash
Case 67: rChr = ChrW(&H2014) ' em dash
Case Else
rChr = "9999999"
End Select
Case Else
rChr = "9999999"
End Select

msgBox (rChr)
If rChr <> "9999999" Then
ReplaceSymbol fSym, iSym, rChr
End If

Wend
End With

''''' Next WHAT needed here?

Resetsearch
End Sub

Private Sub Resetsearch()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub

Private Sub ReplaceSymbol(fSym, iSym, rChr)
Dim sSym As String ' convert symbol number as long to string
sSym = CStr(iSym)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^19symbol " & sSym & " \f " & fSym
.Replacement.Text = rChr
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Can anyone help with what I think is a simple question that any non-beginner
can answer??

Many thanks again.

Edward Mendelson

 

[Helmut Weber]

Hi Edward,
as you are diving deeper an deeper into this,
I am more and more at a loss. And because I don't
have sufficient testing material, I have to code "blind",
as in DOS-times, when the monitor was broken and I had
to rely on "beep beep beep". But still worse, there isn't
even a beep now, when I am wrong.
Maybe applying ReplaceSymbol to another duplicate of rDcm-Range
would help, instead of applying it to an, a as far as I see,
uncontrolled, never redefinded selection. Here I have to give
credits to Thomas Gahler, MVP from Switzerland, who once blamed
me for not using range, encouraged me and helped me a lot.
I just felt I should mention his name.

 

[Edward Mendelson]

Maybe applying ReplaceSymbol to another duplicate of rDcm-Range
would help, instead of applying it to an, a as far as I see,
uncontrolled, never redefinded selection. Here I have to give
credits to Thomas Gahler, MVP from Switzerland...

Hi Helmut,

OK, I will try to figure that out and will report back if there is any
success. Meanwhile, I have sent a sample test file in case you find you have
nothing better to do!

Thanks again, and greetings from New York,

Edward Mendelson