VBA:格式MS Word文本

我正在尝试格式化多个单词的文本。 到目前为止,下面的代码将只允许我格式化一个字的字体。 我需要添加/删除什么才能让我所input的单词格式化得更多?

干杯!

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 

假设你的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

在这里输入图像说明