VBA：运行Excel时自动执行MS Word中的任务

问题描述：

我正试图在Excel文件中运行这个VBA。此代码的第一部分允许我选择一个文件并将其打开。我现在想让代码搜索文件并格式化我要求的单词。我以前在Word中写了这段代码，现在我只是把它变成了excel。有没有一行如withwdapp，告诉excel vba执行Word中的下一步步骤？

I am trying to run this VBA in an excel file. The first part of this code allows me to select a file and open it. I now want to have the code search the file and format the words I ask it to. I have written this code in Word before and am now just having trouble getting it into excel. Is there a line such as "withwdapp" that tells the excel vba to perform the next set of steps in 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

答

将代码更改为此

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

VBA：运行Excel时自动执行MS Word中的任务

相关推荐