Friday, March 14, 2014

How to Change Font Format using VBA

Leave a Comment
In this section, I will show you on how to use vba code to change the format font.
In the following code, I discuss about the how to change the font format bold and italic while in th word document do not have the format of bold and Italic but it has the property of font name with bold or italic for instance Font Time New Roman-Bold. Firstly, in order to change the font format with this case, I need to detach the font name of each words or characters within the word document. And then create the function for finding and replacing with font format as we want to replace.

Detecting the font Propertry

To detect the font name properties in word document, I use vba code called: Range object  and ActiveDocument.content.Paragraphs to find the fount properties in each word or characters.
ActiveDocument.Content.Paragraphs

And then I compare the text string in each words
InStr(1, CStr(fontList(k)), "ITALIC", vbTextCompare)
InStr(1, CStr(fontList(k)), "BOLD", vbTextCompare)


Replacing font Format
In order to change the font bold or italic, I use the following function which take a paramer called font name and use this font for replacing styles

Public SubChangeFontFormatItalic(fontname As String)
    Selection.HomeKey
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Font.Name = fontname
    Selection.Find.Replacement.Font.Italic = True
    With Selection.Find
        .Text = "^?"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

End Sub

'Change Font Name with Bold to Font Time New Roamn with Bold format
Public SubChangeFontFormatBold(fontname As String)
    Selection.HomeKey
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Font.Name = fontname
    Selection.Find.Replacement.Font.Bold = True
    With Selection.Find
        .Text = "^?"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub


Full Code
Here is the full code of this tutorial section

Public Sub ChangeFormatFont
    Dim sTmp As String
    Dim i, j, k As Integer
    Dim opara As Paragraph
    Dim fontFont As Boolean
    Dim fontCount As Integer
    Dim fontList(200) As String
    Dim fontname As String
    Dim fontItalic As String
    Dim fontBold As String

    fontCount = 0
    For Each opara In ActiveDocument.Content.Paragraphs
        If opara.Range.Words.Count > 1 Then
            For i = 1 To opara.Range.Words.Count
                With opara.Range.Words(i)
                    fontname = .Font.Name
                    FoundFont = False
                    For k = 1 To fontCount
                       If fontList(k) = fontname Then FoundFont = True
                    Next k
                    If Not FoundFont Then
                        fontCount = fontCount + 1
                        fontList(fontCount) = fontname
                    End If
'
               ' Debug.Print .Font.Name
              
                End With
            Next i
        End If
    Next opara
    For k = 1 To fontCount
        If InStr(1, CStr(fontList(k)), "ITALIC", vbTextCompare) Then
            fontItalic = fontList(k)
            ChangeFontFormatItalic (fontItalic)
        End If
        If InStr(1, CStr(fontList(k)), "BOLD", vbTextCompare) Then
            fontBold = fontList(k)
            ChangeFontFormatBold (fontBold)
        End If
    Next k
    Debug.Print fontItalic
    Debug.Print fontBold
   
    Set opara = Nothing
    'MsgBox "Complete !!!"
End Sub

Public Sub ChangeFontFormatItalic(fontname As String)
    Selection.HomeKey
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Font.Name = fontname
    Selection.Find.Replacement.Font.Italic = True
    With Selection.Find
        .Text = "^?"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

End Sub

'Change Font Name with Bold to Font Time New Roamn with Bold format
Public Sub ChangeFontFormatBold(fontname As String)
    Selection.HomeKey
    Selection.WholeStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Font.Name = fontname
    Selection.Find.Replacement.Font.Bold = True
    With Selection.Find
        .Text = "^?"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub


That is all for this tutorial. 

0 comments :

Post a Comment