VBA:格式化MS Word文本

Question

我正在尝试格式化多个单词的文本.到目前为止,下面的代码只允许我格式化一个单词的字体.我需要添加/删除什么才能使我输入的单词格式化？

干杯!

Sub FnFindAndFormat()

    Dim objWord
    Dim objDoc
    Dim intParaCount
    Dim objParagraph
    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Open("C:\USERPATH")
    objWord.Visible = True
    intParaCount = objDoc.Paragraphs.Count

    Set objParagraph = objDoc.Paragraphs(1).range
    objParagraph.Find.Text = "deal"

    Do
        objParagraph.Find.Execute
        If objParagraph.Find.Found Then
            objParagraph.Font.Name = "Times New Roman"
            objParagraph.Font.Size = 20
            objParagraph.Font.Bold = True
            objParagraph.Font.Color = RGB(200, 200, 0)
        End If


    Loop While objParagraph.Find.Found

End Sub

Answer 1

假设您的word文档看起来像这样

因为我不确定你是从这样的Word-VBA其他应用程序执行此操作,Excel-VBA所以我说这两种方法都包括在内.

现在,如果你Word-VBA从那时起这样做,你就不需要使用LateBind了.使用这个简单的代码.

Option Explicit

Sub Sample()
    Dim oDoc As Document
    Dim MyAr() As String, strToFind As String
    Dim i As Long

    '~~> This holds your search words
    strToFind = "deal,contract, sign, award"

    '~~> Create an array of text to be found
    MyAr = Split(strToFind, ",")

    '~~> Open the relevant word document
    Set oDoc = Documents.Open("C:\Sample.docx")

    '~~> Loop through the array to get the seacrh text
    For i = LBound(MyAr) To UBound(MyAr)
        With Selection.Find
            .ClearFormatting
            .Text = MyAr(i)
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Execute

            '~~> Change the attributes
            Do Until .Found = False
                With Selection.Font
                    .Name = "Times New Roman"
                    .Size = 20
                    .Bold = True
                    .Color = RGB(200, 200, 0)
                End With
                Selection.Find.Execute
            Loop
        End With
    Next i
End Sub

但是,如果你这样做,Excel-VBA那么使用它

Const wdFindContinue = 1

Sub FnFindAndFormat()
    Dim objWord As Object, objDoc As Object, Rng As Object
    Dim MyAr() As String, strToFind As String
    Dim i As Long

    '~~> This holds your search words
    strToFind = "deal,contract, sign, award"

    '~~> Create an array of text to be found
    MyAr = Split(strToFind, ",")

    Set objWord = CreateObject("Word.Application")
    '~~> Open the relevant word document
    Set objDoc = objWord.Documents.Open("C:\Sample.docx")

    objWord.Visible = True

    Set Rng = objWord.Selection

    '~~> Loop through the array to get the seacrh text
    For i = LBound(MyAr) To UBound(MyAr)
        With Rng.Find
            .ClearFormatting
            .Text = MyAr(i)
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Execute

            Set Rng = objWord.Selection

            '~~> Change the attributes
            Do Until .Found = False
                With Rng.Font
                    .Name = "Times New Roman"
                    .Size = 20
                    .Bold = True
                    .Color = RGB(200, 200, 0)
                End With
                Rng.Find.Execute
            Loop
        End With
    Next i
End Sub

OUTPUT