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

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

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

Many thanks for any help

Edward Mendelson

Jay
Mon Aug 09 11:08:28 CDT 2004

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.)

--
Regards,
Jay Freedman
Microsoft Word MVP FAQ: http://word.mvps.org

Edward Mendelson wrote:
> 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
>
> ---------------------------------------------------------
>
> Many thanks for any help
>
> Edward Mendelson

Helmut
Mon Aug 09 11:40:46 CDT 2004

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
Mon Aug 09 13:46:30 CDT 2004

"Jay Freedman" <jay.freedman@verizon.net> wrote in message
news:uF6AdsifEHA.1424@tk2msftngp13.phx.gbl...
> 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
Mon Aug 09 22:22:16 CDT 2004

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 FAQ: http://word.mvps.org

"Edward Mendelson" <edward_mendelson@ziff-spamaway-davis.com> wrote:

>"Jay Freedman" <jay.freedman@verizon.net> wrote in message
>news:uF6AdsifEHA.1424@tk2msftngp13.phx.gbl...
>> 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
Tue Aug 10 08:28:55 CDT 2004

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


"Jay Freedman" <jay.freedman@verizon.net> wrote in message
news:s8fgh0t9hqju100b4lgjbt0jh28kjqdvck@4ax.com...
> 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 FAQ: http://word.mvps.org
>
> "Edward Mendelson" <edward_mendelson@ziff-spamaway-davis.com> wrote:
>
> >"Jay Freedman" <jay.freedman@verizon.net> wrote in message
> >news:uF6AdsifEHA.1424@tk2msftngp13.phx.gbl...
> >> 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
Tue Aug 10 09:29:50 CDT 2004

Edward Mendelson wrote:
> 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 FAQ: http://word.mvps.org

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
Tue Aug 10 10:10:56 CDT 2004

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



"Jay Freedman" <jay.freedman@verizon.net> wrote in message news:Od$7>
> 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 FAQ: http://word.mvps.org
>
> 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

Klaus
Tue Aug 10 12:41:38 CDT 2004

>[...] 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/groups?threadm=OrdYn5cNDHA.2268%40TK2MSFTNGP12.phx.gbl
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
Tue Aug 10 13:56:03 CDT 2004

"Klaus Linke" <info@fotosatz-kaufmann.de.no.junk> wrote in message
news:eT3tOFwfEHA.2468@TK2MSFTNGP12.phx.gbl...
> >[...] 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/groups?threadm=OrdYn5cNDHA.2268%40TK2MSFTNGP12.phx.gbl
> 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
Tue Aug 10 14:14:40 CDT 2004

"Klaus Linke" <info@fotosatz-kaufmann.de.no.junk> wrote in message
news:eT3tOFwfEHA.2468@TK2MSFTNGP12.phx.gbl...
> >[...] 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
Tue Aug 10 15:22:15 CDT 2004

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" <jay.freedman@verizon.net> wrote in message
news:Od$7$ZufEHA.3428@TK2MSFTNGP11.phx.gbl...
> Edward Mendelson wrote:
> > 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 FAQ: http://word.mvps.org
>
> 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
>
>

Jay
Tue Aug 10 21:56:45 CDT 2004

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.

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

"Edward Mendelson" <edward_mendelson@ziff-spamaway-davis.com> wrote:

>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
>