Search code examples
vbams-wordasianfonts

How to search for and highlight an array of "ChrW(n)" Asian font characters using VBA rather than listing them out


I use a colleague-made macro which scans a document and highlights specified Asian font characters (such as a full stop [ChrW(65294)], an apostrophe [ChrW(65287)]). It works fine, and does exactly what I need it to (highlight Asian font characters) but because it was cobbled together and added to over time, it's incredibly long and not very elegant.

I sometimes need to share it with other colleagues and it's cumbersome having to use such a long macro.

Here's a sample of the code (the actual one is hundreds of lines long):

Sub HighlightAsianCharacters
Selection.Find.ClearFormatting
    With Selection.Find
'full stop
        .Text = ChrW(65294)
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute
    While Selection.Find.Found
    Options.DefaultHighlightColorIndex = wdTurquoise
    Selection.range.HighlightColorIndex = wdTurquoise
    Selection.Find.Execute
    Wend
    Selection.Find.ClearFormatting
    With Selection.Find
'apostrophe
        .Text = ChrW(65287)
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute
    While Selection.Find.Found
    Options.DefaultHighlightColorIndex = wdTurquoise
    Selection.range.HighlightColorIndex = wdTurquoise
    Selection.Find.Execute
    Wend
End Sub

Does anyone know how to put the character codes into an array (for example) so the macro doesn't have to be pages and pages in length?

Many thanks in advance for any help!


Solution

  • Why not simply create a subroutine that replaces one of these characters and pass the character as parameter. Then call the routine for each character you want to handle.

    Sub HighlightAllAsianCharacters
        HighlightAsianCharacter ChrW(65294)
        HighlightAsianCharacter ChrW(65287)
        (...)
    End Sub
    
    Sub HighlightAsianCharacter(asianChr as string)
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = asianChr
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = True
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = False
            .MatchFuzzy = False
        End With
        Selection.Find.Execute
        While Selection.Find.Found   
            Options.DefaultHighlightColorIndex = wdTurquoise
            Selection.range.HighlightColorIndex = wdTurquoise
            Selection.Find.Execute
        Wend
    End Sub
    

    Of course you could collect all characters in an array or collection first and then loop over it, but I don't really see a point in doing so.