Macro for changing fonts

[Anthony Pyles]

Hi All,

 

I thought I had cracked a way to create a macro in Word using Find/Replace All to change any Unicode Greek and Hebrew to a font of my choosing. It works, but only mostly. I'll paste my steps below. The problem seems to be with characters that use combining diacritics, both in Greek and in Hebrew. E.g., for any Hebrew character with a dagesh, the dagesh doesn't get changed but everything around it does, with the result that a vowel under such a character gets bumped out and given a hollow circle (I'll post a screenshot). Similarly, some (but not all!) Greek letters with breathing marks don't get changed.

 

Any suggestions on how to fix this? It happens both with Hebrew/Greek Unicode pasted from Accordance and with Hebrew/Greek Unicode that I type out. Thanks in advance,

 

Tony

 

Edit: here's that screenshot:

 

Fantastic! I’ve cracked a way to ensure all of my Unicode Greek is in a specific font (should work for Hebrew, as well).

 

There are Greek and Greek Extended Unicode ranges, so I need to run two sets of find/replace all.

For the first, paste [Ͱ-Ͽ] into Find, check Use Wildcards, click in the Replace box and then click on Format, changing Font to desired font (e.g., SBLBibLit). Then Replace All!

 

Then do the same with [ἀ-῾] in the Find box.

 

For Hebrew, use [֑-״]

 

FYI the F/RA for Greek will affect some Coptic, but not in the 2C80 to 2CFF range.

 

In order to create a macro for this, follow the above steps with record macro running, then go to the Visual Basic editor. Visual Basic thinks you are trying to replace the Unicode characters with nothing, so the line that has .Replacement.Text = “” needs to be replaced with

         .Replacement.Font.Name = "SBL BibLit"

 

Then it should work!

Edited June 15, 2015 by Tony Pyles

[Anthony Pyles]

Well, it looks like for Hebrew I just need to include another part of the Unicode range, from the so-called Alphabetic presentation forms. So if I include [יִ-ﭏ] in addition to what I have above, the hollow circles sort themselves out. That doesn't explain why the Greek isn't fully working.

[Anthony Pyles]

Looks like the Greek works fine if I don't have Track Changes on. That's weird.

 

Anyway, here's the VB code if anyone wants to create and use this macro for themselves:

Sub Fonts()
'
' Fonts Macro
'
'
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "[" & ChrW(880) & "-" & ChrW(1023) & "]"
        .Replacement.Font.Name = "SBL BibLit"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "[" & ChrW(7936) & "-" & ChrW(8190) & "]"
        .Replacement.Font.Name = "SBL BibLit"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "[" & ChrW(1425) & "-" & ChrW(1524) & "]"
        .Replacement.Font.Name = "SBL BibLit"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "[" & ChrW(64285) & "-" & ChrW(64335) & "]"
        .Replacement.Font.Name = "SBL BibLit"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Execute
End Sub

[Anthony Pyles]

Maybe it is easier to copy/paste if I put it in as a quote. You can change the font names if you want to use different fonts for Greek and Hebrew.

 

 

Sub Fonts()

'

' Fonts Macro

'

'

    Selection.WholeStory

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    Selection.WholeStory

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = "[" & ChrW(880) & "-" & ChrW(1023) & "]"

        .Replacement.Font.Name = "SBL BibLit"

        .Forward = True

        .Wrap = wdFindAsk

        .Format = True

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = True

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = "[" & ChrW(7936) & "-" & ChrW(8190) & "]"

        .Replacement.Font.Name = "SBL BibLit"

        .Forward = True

        .Wrap = wdFindAsk

        .Format = True

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = True

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = "[" & ChrW(1425) & "-" & ChrW(1524) & "]"

        .Replacement.Font.Name = "SBL BibLit"

        .Forward = True

        .Wrap = wdFindAsk

        .Format = True

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = True

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    With Selection.Find

        .Text = "[" & ChrW(64285) & "-" & ChrW(64335) & "]"

        .Replacement.Font.Name = "SBL BibLit"

        .Forward = True

        .Wrap = wdFindAsk

        .Format = True

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = True

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.Find.ClearFormatting

    Selection.Find.Replacement.ClearFormatting

    Selection.Find.Execute

End Sub

 

[Anthony Pyles]

Here is the process in more detail.