Поиск нескольких экземпляров нескольких слов в Word с использованием VBA

Question

Я пишу код VBA, чтобы ввести форму пользователя, а затем перенести эти данные из листа Excel в уже существующий документ Word. Моя часть Excel в порядке.

Мой документ содержит различные слова, такие как номер партии, дата изготовления и т. Д. c. каждый много раз. Я должен буду найти эти слова и вставлять номер партии и дату изготовления из формы пользователя каждый раз, когда они будут найдены во всем документе.

Первоначально я пытался найти одно слово во всем документе, но моя подпрограмма может найти только первый экземпляр и не находит похожих слов в остальной части документа.

Пожалуйста, помогите

Sub Copy_data2()

    Dim my_filename As Variant
    Dim my_filenameword As Variant
    Dim objselection As Object

    'Word Variables
    Dim mres As String
    Dim oword As Object

    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document

    Dim bfound As Boolean
    Dim rngDoc As Word.Range
    Dim rngSearch As Word.Range

    'Excel Variables
    Dim wkbk As Workbook
    Dim irow As Long
    Dim txtSl As String
    Dim txtBNo As String
    Dim txtPr As String
    Dim txtBS As String
    Dim txtMfD As String
    Dim txtExD As String

    Dim workinglocation As String
    Dim workingfilename As String
    Dim workingdir As String
    Dim ret As Boolean
    Dim VbRes As String

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    '--------------------------------------------------------------------------------------------
    'Excel extract values
     '------------------------------------------------------------------------------------------
    VbRes = MsgBox("Please select the Requisition sheet", vbOKOnly + vbInformation, "Select the requisition file")
    my_filename = Application.GetOpenFilename(FileFilter:="Excel Files,*.xls*")
    Set wkbk = Workbooks.Open(my_filename)

    txtPr = FrmMaster.CmbProduct.Text
    txtBNo = FrmMaster.txtBatchNo
    txtBS = FrmMaster.txtBatchSize
    txtMfD = FrmMaster.txtMfgDate
    txtExD = FrmMaster.txtExpDate



    wkbk.Sheets("Requisition").Range("C9") = txtBNo
    wkbk.Sheets("Requisition").Range("G9") = txtBS
    wkbk.Sheets("Requisition").Range("C10") = txtMfD
    wkbk.Sheets("Requisition").Range("G10") = txtExD
    irow = [Counta(Database!A:A)]
    ThisWorkbook.Sheets("Database").Cells(irow, 1) = txtSl
    Debug.Print txtSl

    '-------------------------------------------------------------------------------------------------
    'VB Word
    '----------------------------------------------------------------------------------------------

    mres = MsgBox("Select the Word BMR", vbOKOnly + vbInformation, "Select BMR")
    my_filenameword = Application.GetOpenFilename(FileFilter:="Word Files,*.doc*")

    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True
    wdApp.Activate
    Set wdDoc = wdApp.Documents.Open(my_filenameword)
    wdDoc.Activate


    With wdApp.Selection.Range.Find
        .ClearFormatting
        .Text = "BATCH SIZE"
        bfound = .Execute(Forward:=True)

            Do While bfound = True
            '.Move Unit:=wdCharacter, Count:=4
             .Text = "BATCH SIZE"
             .Replacement.Text = "Size"
            Loop

    End With

    my_filenameword.Close True


    wkbk.Close True


    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True


 End Sub

Answer 1

Вы действительно должны потратить несколько минут на изучение Find / Replace in Word. Даже рекордер макросов даст вам большую часть кода, который вам нужен. Попробуйте:

  Set wdDoc = wdApp.Documents.Open(my_filenameword, , False, False, , , , , , , , False)
  With wdDoc
    With .Range.Find
      .Forward = True
      .Wrap = wdFindContinue
      .Text = "BATCH SIZE"
      .Replacement.Text = "Size"
      .Execute Replace:=wdReplaceAll
    End With
    .Close True
  End With

Как видите, зацикливание не требуется - просто правильное применение Find / Replace.