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