VBA：通过Excel运行时，在MS Word中自动执行任务

我想在一个excel文件中运行这个VBA。 这段代码的第一部分允许我select一个文件并打开它。 我现在想让代码search文件并格式化我要求的单词。 我之前已经在Word中编写过这个代码，现在只是无法进入到Excel中。 是否有像“withwdapp”这样的行告诉excel vba在Word中执行下一步的步骤？

Sub Find_Key_Words() 'Open an existing Word Document from Excel Dim FileToOpen Dim appwd As Object ChDrive "C:\" FileToOpen = Application.GetOpenFilename _ (Title:="Please choose a file to import", _ FileFilter:="Word Files *.docx (*.docx),") If FileToOpen = False Then MsgBox "No file specified.", vbExclamation, "Error" Exit Sub Else Set appwd = CreateObject("Word.Application") appwd.Visible = True appwd.Documents.Open Filename:=FileToOpen End If Dim objWord As Object, objDoc As Object, Rng As Object Dim MyAr() As String, strToFind As String Dim i As Long 'This holds search words strToFind = "w1,w2, w3, w4" 'Create an array of text to be found MyAr = Split(strToFind, ",") Set objWord = CreateObject("Word.Application") 'Open the relevant word document : CAN THIS BE DELETED? 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 

Answer 1

将您的代码更改为此。

 Const wdFindContinue = 1 Sub FnFindAndFormat() Dim FileToOpen 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, ",") FileToOpen = Application.GetOpenFilename _ (Title:="Please choose a file to import", _ FileFilter:="Word Files *.docx (*.docx),") If FileToOpen = False Then Exit Sub Set objWord = CreateObject("Word.Application") '~~> Open the relevant word document Set objDoc = objWord.Documents.Open(FileToOpen) 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