CamelCase plus other to CourierNew font (2010)

[Robie]

Is it possible for Word to recognise CamelCase and turn it into using a different font? Perhaps, is it possible for a macro to apply the font Courier New (10pt regular) to the following types of text ?

So for example a sentence:
This is a AcmeTableTop v12.1.0 and the tar is called acme.v12.1.0.tar.z.
to be
This is a AcmeTableTop v12.1.0 and the tar is called acme.v12.1.0.tar.z.

1. Anything in CamelCase (so called).
Example:
DefaultTickScale

2. Any string of words that are separated only by underscores or periods.
Examples:
(1) cbcd.v12.1.0.tar.Z
(2) abcd_SystemDefinition.cfg (contains both)
(3) ABCD_OPUB

Thanks.
Robie

[HansV]

I think this would be quite complicated because the number of elements can vary, and in #2, periods also being used to end a sentence.

Here are two very simplistic macros that do only part of what you want; you may be able to expand them:

Code: Select all

Sub Macro1()
    ' Handle simple form of CamelCase
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = " [A-Z][a-z]@[A-Z][a-z]@ "
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Replacement.Font.Size = 10
        .Replacement.Font.Name = "Courier New"
        .Execute Replace:=wdReplaceAll
    End With
End Sub

Sub Macro2()
    ' Handle words with one period or underscore
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = " [A-Za-z0-9]@[._][A-Za-z0-9]@ "
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        .Replacement.Font.Size = 10
        .Replacement.Font.Name = "Courier New"
        .Execute Replace:=wdReplaceAll
    End With
End Sub

[Robie]

I think this would be quite complicated because the number of elements can vary, and in #2, periods also being used to end a sentence.

Here are two very simplistic macros that do only part of what you want; you may be able to expand them:

Thank you very much Hans. Your code got me pretty far.

Anyway, I changed is slightly (whether good, bad or ugly I don't know). What I did was for each find I would extend the selection to the start of the word and to the end of word delimited by space, vbCr, vbLF, vbTab. This seems to work except for one condition.

Code: Select all

Sub SetCamelCase()
    ' Handle simple form of CamelCase
    
    Application.ScreenUpdating = False
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "[A-Z][a-z]@[A-Z][a-z]@"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    While (Selection.Find.Execute)
        Selection.Start = SetToCourierNew
    Wend
    Application.ScreenUpdating = True
End Sub

Sub SetPeriodAndUnderscore()
    ' Handle words with one period or underscore
    
    Application.ScreenUpdating = False
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "[A-Za-z0-9]@[._][A-Za-z0-9]@"
        .Replacement.Text = "^&"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    
    While (Selection.Find.Execute)
        Selection.Start = SetToCourierNew
    Wend
    Application.ScreenUpdating = True

Function SetToCourierNew() As Long
    Dim strDelim As String
    
    On Error GoTo ExitHandler
    ' Delimiters
    strDelim = "^l" & " " & vbCr & vbTab & vbLf
    With Selection
        ' Select whole word
        .MoveStartUntil strDelim, wdBackward
        .MoveEndUntil strDelim, wdForward
        ' Set font
        .Font.Name = "Courier New"
        ' Make sure this is not checked for spelling
        .NoProofing = True
    End With
    SetToCourierNew = Selection.End + 1
ExitHandler:
End Function
End Sub

If the last word of a line is to be changed to 'Courier New' and it ends in manual line break then I am unable to use that as a delimer. Do you have any idea how to do this please?

20.png

Thanks.

[Robie]

I found another way to do. I replace all 'manual line break' ("^1")with a special string (" mmmmm"). Then run the two macro and then reset the special string to manual like breaks. It seems to do the job.

Would love to know if there is a way to set 'manual line break' as a delimer to find though.

Robie

[HansV]

A manual line break is Chr(11), so you might try adding that to your string:

strDelim = "^l" & " " & vbCr & vbTab & vbLf & Chr(11)

[Robie]

A manual line break is Chr(11), so you might try adding that to your string:

strDelim = "^l" & " " & vbCr & vbTab & vbLf & Chr(11)

Perfect. That works beautifully.
Thank you