CODEWITHSUNDEEP
vbams-word
Vasilis Ioannidis
Vasilis Ioannidis

Reputation: 48

Apply format in a paragraph with multiple fonts

In my docs I use either Arial or Courier New (for code) and sometimes both in the same paragraph. As I share my docs with other people, they tend to use other fonts as well but it is important to keep it aligned, that;s why I am trying to create a macro that will turn all non-Courier New text into Arial and into the correct font size (11).

I face 2 problems with what I have achieved so far:

  1. In paragraphs with mixed fonts it tends to change the whole paragraph (including the code) to Arial, while i need it to change only the non-code text
  2. It changes the font size not only in the body text but in the headings as well.

I think I'm using incorrectly the objects of Word (I'm used in working in Excel) but I can't find anywhere online any clues. Can anyone help me please?

Sub CorrectFont()
    Dim p As paragraph
    Set p = ActiveDocument.Paragraphs(1)

    Application.Visible = False
    Application.ScreenUpdating = False

    Do
        If p.Range.Font.Name <> "Courier New" Then
           p.Range.Font.Name = "Arial"
           p.Range.Font.Size = 11
        End If
        Set p = p.Next
    Loop Until p Is Nothing

    Application.ScreenUpdating = True
    Application.Visible = True
End Sub

Upvotes: 0

Views: 1408

Answers (2)

Vasilis Ioannidis
Vasilis Ioannidis

Reputation: 48

Thanks to @destination-data 's inputs I reached a final form of the code. I present it here for anyone that might be interested.

Thank you again! 

Sub AlignFont()
Dim wd As Range

Application.Visible = False
Application.ScreenUpdating = False

' Check each word, one at a time.
For Each wd In ActiveDocument.Words

    'On objects like Contents it may create an error and crash
    On Error Resume Next
        If wd.Font.Name <> "Courier New" And wd.Style = "Normal" Then
            wd.Font.Name = "Arial"
        End If

        'To avoid any header that may have a "Normal" style
        If wd.Font.Bold = False Then
            wd.Font.Size = 11
        End If
Next

Application.ScreenUpdating = True
Application.Visible = True

End Sub

Upvotes: 0

David Rushton
David Rushton

Reputation: 5030

You can check each individual word, like so:

' Replaces non-Arial fonts with Arial.
' Exception: Courier New is not replaced.
Sub AlignFont()
    Dim wd As Range

    ' Check each word, one at a time.
    For Each wd In ActiveDocument.Words

        If Not (wd.Font.Name = "Arial" Or wd.Font.Name = "Courier New") Then

            wd.Font.Name = "Arial"
        End If
    Next
End Sub

Upvotes: 1

Related Questions