How to find and replace the Calibri font using VBA in MS Word-CodePudding

I am going to find the Calibri font in my document and replace with same content and same font (Calibri) with XML tag before and after <Cal></Cal>. I manually find and replacing each time. If i recorded this as a macro it not working.

Sub Caliberi_Font()
'
' Caliberi_Font Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    
    With Selection.Find
        .Text = ""
        .Replacement.Text = "<cal>^&</cal>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

If i modify (or add) the line Selection.Find.Font.Name = "Calibri" to the macro then also not working

Sub Caliberi_Font()

'
' Caliberi_Font Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Font.Name = "Calibri"
    
    With Selection.Find
        .Text = ""
        .Replacement.Text = "<cal>^&</cal>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

My Input DOC file in Calibri font

My Input DOC file

My Output DOC file need to replace

My required output

CodePudding user response：

Try:

Sub Calibri_Font()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Font.Name = "Calibri"
  .Text = ""
  .Replacement.Text = "<cal>^&</cal>"
  .Forward = True
  .Format = True
  .Wrap = wdFindContinue
  .Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub