Make Word macro find text in footnotes, headers, etc?

[Edward Mendelson]

Hello,

This is a question about a macro in which all the good ideas were offered by
Helmut Weber in answer to questions that I posted here in earlier threads.
Thanks to Helmut, I have a Word macro that helps fix a problem with
WordPerfect 5.1 documents imported into Word 2002 - but so far, the macro
works only with the main story in a document - not with the footnotes and
headers, etc. Can anyone help with this last part of the problem?

Here is the background: When Word 2002 opens a WordPerfect 5.1 document with
typographical symbols such as curly quotation marks and em or en dashes, or
some non-English alphabetical characters like the "oe" ligature, these
symbols are not converted into native Windows characters, but are stored as
invisible symbols. Helmut showed me how to devise a macro that replaces
these symbols, and the code is at the foot of the message.

I found this page has example code for making a find/replace operation work
through an entire document, but I have not been able to adapt it to work
with the kind of operation in this macro:

http://word.mvps.org/FAQs/MacrosVBA/FindReplaceAllWithVBA.htm

Can anyone help adapt it to the needs of this macro? Many thanks for any
advice.

Here is the code of the macro that works in the main story: Cut on the
dotted line:

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

Sub ChangeWPCharactersToNativeWindowsCharacters

Set dlg = Dialogs(wdDialogInsertSymbol)
FirstOccasion = True

Dim rDcm As Range
Dim oChr As Object
Dim sFnt As String ' font name
Dim iFnt As Integer ' character number
' for the following lines to work correctly, insert a form anywhere
' in the VBA project - simply use Insert/User Form, and then
' press Ctrl-F4 to close the form
Dim oDat As DataObject
Set oDat = New DataObject
Set rDcm = ActiveDocument.Range
For Each oChr In rDcm.Characters
If Asc(oChr) = 40 Then
' applies to most (or all) decorative fonts?
oChr.Select
' If Asc(Selection.Text) <> iAsc Then
' from previous posting would fit in here
' plus select case
SendKeys "%f^c{ESC}{ESC}" ' English version
dlg.Display
iFnt = Dialogs(wdDialogInsertSymbol).charnum
oDat.GetFromClipboard
sFnt = oDat.GetText
' for determining font name when adding changes
' MsgBox (sFnt)
' Debug.Print sFnt, iFnt

' change for WP TypographicSymbols font only
' fill in more characters later
If sFnt = "WP TypographicSymbols" Then
If Asc(Selection.Text) <> iFnt Then
Select Case iFnt
Case 64: Selection.TypeText Text:=Chr$(148) 'closing curly quote
Case 65: Selection.TypeText Text:=Chr$(147) 'opening curly quote
Case 66: Selection.TypeText Text:=Chr$(45) 'en dash
Case 67: Selection.TypeText Text:=Chr$(150) 'em dash
End Select
End If
End If

' change for Multinational Ext font only
' fill in more characters later
If sFnt = "Multinational Ext" Then
If Asc(Selection.Text) <> iFnt Then
Select Case iFnt
Case -3951: Selection.TypeText Text:=Chr$(156) 'oe ligature
End Select
End If
End If

' insert changes for other WP fonts here

End If
Next

End Sub

 

[Jay Freedman]

Hi Edward,

The only idea you need from the FAQ article is that you have to loop through
each StoryRange in the document. In your macro, you need to change one line
and add one line.

Change this

Set rDcm = ActiveDocument.Range

to this

For Each rDcm In ActiveDocument.StoryRanges

and then put the line

Next rDcm

between the Next and the End Sub. (Technically, the existing Next should be
Next oChr.)

 

[Helmut Weber]

Hi Edward and Jay, and thanks to Doug Robbins, who wrote:
"As mentioned previously, the [...] code will only act upon the first
story for each story type in the document. (The first Header, the
first Text Box, and so on). If your document contains sections with
unlinked headers and footers in them, or, for example, contains more
than one Text Box, the code will not act upon the second and
subsequent occurrences of each type of story."
Just in the very rare case of "sections with unlinked headers
and footers" or "more than one Text Box", we could handle that, too.
Let us know, if you need further assistance.
Great fun!
Greetings from Bavaria, Germany
Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98

 

[Edward Mendelson]

Hi Edward,

The only idea you need from the FAQ article is that you have to loop through
each StoryRange in the document. In your macro, you need to change one line
and add one line.

Change this

Set rDcm = ActiveDocument.Range

to this

For Each rDcm In ActiveDocument.StoryRanges

and then put the line

Next rDcm

between the Next and the End Sub. (Technically, the existing Next should be
Next oChr.)

Hi Jay,

Thank you! That got me sorted out. The only remaining problem was the one
that Helmut indicated in his reply - that the macro only works with the
first of the multiple headers that can be an imported WP file.

So I finally figured out how to handle the second suggestion in Doug
Robbins' FAQ, and made the macro loop as shown below. The only problem with
this method is that the block of code starting with "For Each oChr In
rDcm.Characters" and ending with "Next oChr" is repeated in full, which is
obviously not desirable. But I want to make this a single subroutine for
easy distribution to non-technical users. Is there an obvious way that any
beginner should know (but that I don't know) to avoid repeating that large
block of code?

Many thanks again for all the help here. (PS: I should mention that I had
figured out on my own (again with Helmut's help) a completely different
method, which involved saving the file in WinWord 2.0 format, and then
reopening it in Word 2000 - a procedure that revealed all the invisible
symbol fields so that they could be manipulated with easy find/replace. I
may post that one in another thread because it seems to me useful to have
both - by saving in WinWord 2.0, you can see any symbols that weren't
replaced by the macro below.)

Code for the corrected macro under my signature...

Edward Mendelson

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

Sub ChangeWPCharactersToNativeWindowsCharactersInAllRanges

' mostly suggested by Helmut Weber,
' with improvements by Jay Freedman,
' based on article by Doug Robbins

Set dlg = Dialogs(wdDialogInsertSymbol)
FirstOccasion = True

Dim rDcm As Range
Dim oChr As Object
Dim sFnt As String ' font name
Dim iFnt As Integer ' character number
Dim oDat As DataObject
Set oDat = New DataObject

For Each rDcm In ActiveDocument.StoryRanges ' added for headers, footers,
etc.
For Each oChr In rDcm.Characters
If Asc(oChr) = 40 Then
' applies to most (or all) decorative fonts?
oChr.Select
SendKeys "%f^c{ESC}{ESC}" ' English version
dlg.Display
iFnt = Dialogs(wdDialogInsertSymbol).charnum
oDat.GetFromClipboard
sFnt = oDat.GetText
' for determining font name when adding changes use either or both:
' MsgBox (sFnt)
' Debug.Print sFnt, iFnt

' change for WP TypographicSymbols font only
' fill in more characters later
If sFnt = "WP TypographicSymbols" Then
If Asc(Selection.Text) <> iFnt Then
Select Case iFnt
Case 64: Selection.TypeText Text:=Chr$(148) 'closing curly quote
Case 65: Selection.TypeText Text:=Chr$(147) 'opening curly quote
Case 66: Selection.TypeText Text:=Chr$(45) 'en dash
Case 67: Selection.TypeText Text:=Chr$(150) 'em dash
End Select
End If
End If

' change for Multinational Ext font only
' fill in more characters later
If sFnt = "Multinational Ext" Then
If Asc(Selection.Text) <> iFnt Then
Select Case iFnt
Case -3951: Selection.TypeText Text:=Chr$(156) 'oe ligature
End Select
End If
End If

' insert changes for other WP fonts here

End If
Next oChr

' newly added for looping through disconnected story ranges
Do While Not (rDcm.NextStoryRange Is Nothing)
Set rDcm = rDcm.NextStoryRange

For Each oChr In rDcm.Characters
If Asc(oChr) = 40 Then
' applies to most (or all) decorative fonts?
oChr.Select
SendKeys "%f^c{ESC}{ESC}" ' English version
dlg.Display
iFnt = Dialogs(wdDialogInsertSymbol).charnum
oDat.GetFromClipboard
sFnt = oDat.GetText
' for determining font name when adding changes
' MsgBox (sFnt)
' Debug.Print sFnt, iFnt

' change for WP TypographicSymbols font only
' fill in more characters later
If sFnt = "WP TypographicSymbols" Then
If Asc(Selection.Text) <> iFnt Then
Select Case iFnt
Case 64: Selection.TypeText Text:=Chr$(148) 'closing curly quote
Case 65: Selection.TypeText Text:=Chr$(147) 'opening curly quote
Case 66: Selection.TypeText Text:=Chr$(45) 'en dash
Case 67: Selection.TypeText Text:=Chr$(150) 'em dash
End Select
End If
End If

' change for Multinational Ext font only
' fill in more characters later
If sFnt = "Multinational Ext" Then
If Asc(Selection.Text) <> iFnt Then
Select Case iFnt
Case -3951: Selection.TypeText Text:=Chr$(156) 'oe ligature
End Select
End If
End If

' insert changes for other WP fonts here

End If
Next oChr

' newly added for looping through disconnected story ranges
Loop

'added for headers, footers etc.
Next rDcm

End Sub

 

[Jay Freedman]

Hi Edward,

See the rearranged code below. The way to avoid repeating a large
block of code is to pull it out of the main routine into a subroutine,
and call the subroutine where it's needed. In this case you need to
pass the range rDcm as an "argument" (input data) so the subroutine
knows which piece of document to work on.

--
Regards,
Jay Freedman http://aspnet2.com/mvp.ashx?JayFreedman
Microsoft Word MVP

Hi Edward,

[snip]
Hi Jay,

Thank you! That got me sorted out. The only remaining problem was the one
that Helmut indicated in his reply - that the macro only works with the
first of the multiple headers that can be an imported WP file.

So I finally figured out how to handle the second suggestion in Doug
Robbins' FAQ, and made the macro loop as shown below. The only problem with
this method is that the block of code starting with "For Each oChr In
rDcm.Characters" and ending with "Next oChr" is repeated in full, which is
obviously not desirable. But I want to make this a single subroutine for
easy distribution to non-technical users. Is there an obvious way that any
beginner should know (but that I don't know) to avoid repeating that large
block of code?
[snip]

Sub ChangeWPCharactersToNativeWindowsCharactersInAllRanges()

' mostly suggested by Helmut Weber,
' with improvements by Jay Freedman,
' based on article by Doug Robbins

Set dlg = Dialogs(wdDialogInsertSymbol)
FirstOccasion = True

Dim rDcm As Range
Dim oChr As Object
Dim sFnt As String ' font name
Dim iFnt As Integer ' character number
Dim oDat As DataObject
Set oDat = New DataObject

For Each rDcm In ActiveDocument.StoryRanges
CharacterByCharacterSearch(rDcm)

' newly added for looping through disconnected story ranges
Do While Not (rDcm.NextStoryRange Is Nothing)
Set rDcm = rDcm.NextStoryRange
CharacterByCharacterSearch(rDcm)
Loop
Next rDcm
End Sub

Private Sub CharacterByCharacterSearch(rDcm As Range)
For Each oChr In rDcm.Characters
If Asc(oChr) = 40 Then
' applies to most (or all) decorative fonts?
oChr.Select
SendKeys "%f^c{ESC}{ESC}" ' English version
dlg.Display
iFnt = Dialogs(wdDialogInsertSymbol).charnum
oDat.GetFromClipboard
sFnt = oDat.GetText
' for determining font name when adding changes
' use either or both:
' MsgBox (sFnt)
' Debug.Print sFnt, iFnt

' change for WP TypographicSymbols font only
' fill in more characters later
If sFnt = "WP TypographicSymbols" Then
If Asc(Selection.Text) <> iFnt Then
Select Case iFnt
Case 64: Selection.TypeText Text:=Chr$(148)
'closing curly quote
Case 65: Selection.TypeText Text:=Chr$(147)
'opening curly quote
Case 66: Selection.TypeText Text:=Chr$(45) 'en dash
Case 67: Selection.TypeText Text:=Chr$(150) 'em dash
End Select
End If
End If

' change for Multinational Ext font only
' fill in more characters later
If sFnt = "Multinational Ext" Then
If Asc(Selection.Text) <> iFnt Then
Select Case iFnt
Case -3951: Selection.TypeText Text:=Chr$(156)
'oe ligature
End Select
End If
End If

' insert changes for other WP fonts here

End If
Next oChr
End Sub

 

[Edward Mendelson]

Hi Jay,

Thanks again for your trouble over this. Like any beginner, I'm sure I'm
doing something foolish, but I get a compile error when I try to run this. I
created a new module, inserted the complete code below, and ran it - but got
a Compile Error: Type Mismatch, with the highlight on the second of these
two liines in the main sub:

For Each rDcm In ActiveDocument.StoryRanges
CharacterByCharacterSearch (rDcm)

The private sub CharacterByCharacterSearch IS in the same module,
immediately below the main sub.

Am I doing something obviously wrong here?

Many thanks again for your generous help with this!

Edward Mendelson

Hi Edward,

See the rearranged code below. The way to avoid repeating a large
block of code is to pull it out of the main routine into a subroutine,
and call the subroutine where it's needed. In this case you need to
pass the range rDcm as an "argument" (input data) so the subroutine
knows which piece of document to work on.

--
Regards,
Jay Freedman http://aspnet2.com/mvp.ashx?JayFreedman
Microsoft Word MVP

Hi Edward,

[snip]
Hi Jay,

Thank you! That got me sorted out. The only remaining problem was the one
that Helmut indicated in his reply - that the macro only works with the
first of the multiple headers that can be an imported WP file.

So I finally figured out how to handle the second suggestion in Doug
Robbins' FAQ, and made the macro loop as shown below. The only problem with
this method is that the block of code starting with "For Each oChr In
rDcm.Characters" and ending with "Next oChr" is repeated in full, which is
obviously not desirable. But I want to make this a single subroutine for
easy distribution to non-technical users. Is there an obvious way that any
beginner should know (but that I don't know) to avoid repeating that large
block of code?
[snip]
---------------------------------------------------------------------------

-Sub ChangeWPCharactersToNativeWindowsCharactersInAllRanges()

' mostly suggested by Helmut Weber,
' with improvements by Jay Freedman,
' based on article by Doug Robbins

Set dlg = Dialogs(wdDialogInsertSymbol)
FirstOccasion = True

Dim rDcm As Range
Dim oChr As Object
Dim sFnt As String ' font name
Dim iFnt As Integer ' character number
Dim oDat As DataObject
Set oDat = New DataObject

For Each rDcm In ActiveDocument.StoryRanges
CharacterByCharacterSearch(rDcm)

' newly added for looping through disconnected story ranges
Do While Not (rDcm.NextStoryRange Is Nothing)
Set rDcm = rDcm.NextStoryRange
CharacterByCharacterSearch(rDcm)
Loop
Next rDcm
End Sub

Private Sub CharacterByCharacterSearch(rDcm As Range)
For Each oChr In rDcm.Characters
If Asc(oChr) = 40 Then
' applies to most (or all) decorative fonts?
oChr.Select
SendKeys "%f^c{ESC}{ESC}" ' English version
dlg.Display
iFnt = Dialogs(wdDialogInsertSymbol).charnum
oDat.GetFromClipboard
sFnt = oDat.GetText
' for determining font name when adding changes
' use either or both:
' MsgBox (sFnt)
' Debug.Print sFnt, iFnt

' change for WP TypographicSymbols font only
' fill in more characters later
If sFnt = "WP TypographicSymbols" Then
If Asc(Selection.Text) <> iFnt Then
Select Case iFnt
Case 64: Selection.TypeText Text:=Chr$(148)
'closing curly quote
Case 65: Selection.TypeText Text:=Chr$(147)
'opening curly quote
Case 66: Selection.TypeText Text:=Chr$(45) 'en dash
Case 67: Selection.TypeText Text:=Chr$(150) 'em dash
End Select
End If
End If

' change for Multinational Ext font only
' fill in more characters later
If sFnt = "Multinational Ext" Then
If Asc(Selection.Text) <> iFnt Then
Select Case iFnt
Case -3951: Selection.TypeText Text:=Chr$(156)
'oe ligature
End Select
End If
End If

' insert changes for other WP fonts here

End If
Next oChr
End Sub

 

[Jay Freedman]

Hi Jay,

Thanks again for your trouble over this. Like any beginner, I'm sure
I'm doing something foolish, but I get a compile error when I try to
run this. I created a new module, inserted the complete code below,
and ran it - but got a Compile Error: Type Mismatch, with the
highlight on the second of these two liines in the main sub:

For Each rDcm In ActiveDocument.StoryRanges
CharacterByCharacterSearch (rDcm)

The private sub CharacterByCharacterSearch IS in the same module,
immediately below the main sub.

Am I doing something obviously wrong here?

Many thanks again for your generous help with this!

Edward Mendelson

Hi Edward,

Sorry, it isn't you. That's what happens when I rush and make changes in a
plain text editor without checking them in running VBA. The error you saw
was caused by my mistake in including the parentheses around rDCM in the
call to the subroutine -- VBA has different rules than VB for this. The
other thing you would have tripped over, had you gotten that far, is that
all the Dim statements except the one for rDcm have to be moved into the
subroutine, where those variables are used. The assignment of the dlg object
also needs to be moved. Here's a version that I tested as far as I could (I
don't have the WP TypographicSymbols or Multinational Ext fonts to try a
complete test).

--
Regards,
Jay Freedman
Microsoft Word MVP

Sub ChangeWPCharactersToNativeWindowsCharactersInAllRanges()

' mostly suggested by Helmut Weber,
' with improvements by Jay Freedman,
' based on article by Doug Robbins

Dim rDcm As Range

For Each rDcm In ActiveDocument.StoryRanges
CharacterByCharacterSearch rDcm

' newly added for looping through disconnected story ranges
Do While Not (rDcm.NextStoryRange Is Nothing)
Set rDcm = rDcm.NextStoryRange
CharacterByCharacterSearch rDcm
Loop
Next rDcm
End Sub

Private Sub CharacterByCharacterSearch(rDcm As Range)
Dim dlg As Dialog
Dim oChr As Object
Dim sFnt As String ' font name
Dim iFnt As Integer ' character number
Dim oDat As DataObject
Set oDat = New DataObject
Set dlg = Dialogs(wdDialogInsertSymbol)
For Each oChr In rDcm.Characters
If Asc(oChr) = 40 Then
' applies to most (or all) decorative fonts?
oChr.Select
SendKeys "%f^c{ESC}{ESC}" ' English version
dlg.Display
iFnt = dlg.charnum
oDat.GetFromClipboard
sFnt = oDat.GetText
' for determining font name when adding changes
' use either or both:
' MsgBox (sFnt)
' Debug.Print sFnt, iFnt

' change for WP TypographicSymbols font only
' fill in more characters later
If sFnt = "WP TypographicSymbols" Then
If Asc(Selection.Text) <> iFnt Then
Select Case iFnt
Case 64: Selection.TypeText Text:=Chr$(148)
'closing curly quote
Case 65: Selection.TypeText Text:=Chr$(147)
'opening curly quote
Case 66: Selection.TypeText Text:=Chr$(45) 'en dash
Case 67: Selection.TypeText Text:=Chr$(150) 'em dash
End Select
End If
End If

' change for Multinational Ext font only
' fill in more characters later
If sFnt = "Multinational Ext" Then
If Asc(Selection.Text) <> iFnt Then
Select Case iFnt
Case -3951: Selection.TypeText Text:=Chr$(156)
'oe ligature
End Select
End If
End If

' insert changes for other WP fonts here

End If
Next oChr
End Sub

 

[Edward Mendelson]

Hi Jay,

Many thanks for your continuing effort over this. The revised version does
run, but there seems to be something wrong in the way it handles the iFnt
variable - this version either returns 0 or an incorrect value (apparently
from an earlier character). I've tried inserting FirstOccasion=True after
the dialog is invoked, but that doesn't help.

If you're feeling *really* generous with your time and expertise, I've
posted a sample test document and the two font files that Word 2002 uses
when dealing with it at this address:

ftp://www.columbia.edu/c/u/2/e/em36/public_html/wp5test.zip

You probably already have the MULTIEXT.TTF file on your system, but I
included it just in case.

Again, many, many thanks for your help with this one. I don't remember if I
mentioned that I'm planning to post a version of this final macro in public,
because it's something that a lot of users seem to need.

Edward Mendelson

 

[Klaus Linke]

[...] I'm planning to post a version of this final macro in public,

because it's something that a lot of users seem to need.

Amen!!

Perhaps you can use the replacements from my macro here:
http://www.google.com/[email protected]
for WP Typographic Symbols.

I never had much luck with the macros I posted to fix WP symbols. Whether
they worked seemed to depend on the WP version, the Word version, and the
file format. Difficult to cover all bases :-(

Some users found that removing the WP fonts makes Word change the symbols
to proper Unicode symbols on import...
It seems that at least in some version(s), Word will only keep the WP
symbol fonts for round-tripping when those fonts are installed, but knows
how to turn them into Unicode if needed.

Regards,
Klaus

 

[Edward Mendelson]

[...] I'm planning to post a version of this final macro in public,
because it's something that a lot of users seem to need.

Amen!!

Perhaps you can use the replacements from my macro here:
http://www.google.com/[email protected]
for WP Typographic Symbols.

Excellent list, Klaus! Thank you. I'll try to add it to the macro (which
isn't my macro, really, but Helmut's - I worked out an enormous kludge that
also worked, but in a much bigger and more complicated way, and Helmut's is
infinitely better).

However, like you, I can't make the macro replace the inverted Spanish
exclamation mark - my macro correctly reports that the font is WP
TypographicSymbols, character 40, but it refuses to do anything - it won't
post a special message box or type "FAILED" or anything else that I've
tried. Very puzzling! (The same problem applies to the inverted Spanish
question mark, too, apparently.)

Edward Mendelson

 

[Edward Mendelson]

[...] I'm planning to post a version of this final macro in public,
because it's something that a lot of users seem to need.

Follow-up: I figured out a way to fix the problem with the Spanish
punctuation. Now, I am only hoping for a solution to the problem in which I
need the same code twice to avoid the problem with making corrections in
headers, etc.

If you know of any other characters that caused problems, please let me
know!

Edward Mendelson

 

[Edward Mendelson]

Hi Jay,

I figured out how to make your efficient version work correctly, but I can't
figure out why the change helped - perhaps someone here can explain it?

When I ran your code in the previous message, it apparently did not extract
the right character number from the dialog. I found that I could make it
work correctly by moving the line

Set dlg = Dialogs(wdDialogInsertSymbol)

from where it is in the code you sent (in the list of declarations at the
top of the private sub) to this position (I've shown the surrounding lines
for clarity):

For Each oChr In rDcm.Characters
If Asc(oChr) = 40 Then
' applies to most (or all) decorative fonts?
oChr.Select
SendKeys "%f^c{ESC}{ESC}" ' English version
Set dlg = Dialogs(wdDialogInsertSymbol)
dlg.Display
iFnt = dlg.charnum

It can also go above the SendKeys line.

Why should this work and the general declaration not work? It's a major
puzzle - but thanks again for sorting out the problems in my initial
version!

Edward Mendelson

 

[Jay Freedman]

Hi Edward,

I wouldn't have guessed that fix, and it doesn't make a lot of sense
to me, but I can make a semi-educated guess.

By reassigning the built-in dialog object to the dlg variable each
time it's about to be displayed, I think all its member variables
(particularly .charnum) are being "zeroed out" each time. Possibly in
the earlier version there was something being left over after each
display and that caused the problem. Since I don't know the internals
of the dialog object, it's impossible to say.