查找單詞中的文本並在其後插入數據

Question

我有以下VBA腳本將數據從excel工作表複製到單詞中。這工作正常。

現在在粘貼之前，我想搜索word文檔中的工作表名稱並在其下面粘貼其各自的數據。到目前爲止，我在腳本中包含了find函數，但不知道如何進一步進行。

可以請指導我如何獲取找到的文本的位置並在其後插入粘貼？

Sub ETW() 

    Dim WordApp As Word.Application 
    Dim myDoc As Word.Document 
    Dim WordTable As Word.Table 
    Dim ws As Worksheet 
    Dim LastRow As Long 
    Dim LastColumn As Long 
    Dim pasteRange As Word.Range 
    Dim StartCell As Range 
    Set StartCell = Range("A2") 

    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
    Set WordApp = GetObject(class:="Word.Application") 
    WordApp.Visible = True 
    WordApp.Activate 

    Set myDoc = WordApp.Documents.Open("D:\asd.docx") 

    For Each ws In ThisWorkbook.Worksheets 
     Debug.Print ws.Name, ThisWorkbook.Worksheets.Count 
     'ws.UsedRange 
     LastRow = StartCell.SpecialCells(xlCellTypeLastCell).Row 
     LastColumn = StartCell.SpecialCells(xlCellTypeLastCell).Column 
     ws.Range("A2", ws.Cells(LastRow, LastColumn)).Copy 

     Debug.Print "LastRow: "; LastRow, "LastColumn: "; LastColumn 

     'Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
     'Range("E2").Value = "Mandatory" 

     With myDoc.Content.Find 
      .Forward = True 
      .Wrap = wdFindStop 
      .Text = ws.Name 
      .Execute 
     End With 

     Set pasteRange = myDoc.Content 
     pasteRange.Collapse wdCollapseEnd 
     pasteRange.Paste 

'Autofit Table so it fits inside Word Document 
     'Set WordTable = myDoc.Tables(1) 
     'WordTable.AutoFitBehavior (wdAutoFitWindow) 
     myDoc.Save 

EndRoutine: 
'Optimize Code 
     Application.ScreenUpdating = True 
     Application.EnableEvents = True 

'Clear The Clipboard 
     Application.CutCopyMode = False 
    Next ws 
End Sub 

Answer 1

試試這個

Dim findRange As Word.Range 
'... 
Set findRange = myDoc.Content 
With findRange.Find 
    .Forward = True 
    .Wrap = wdFindStop 
    .Text = ws.Name 
    .Execute 
End With 
'now findrange is the first match of the search text so we can paste behind 
findRange.Collapse wdCollapseEnd 
findRange.Paste 

當然，你可能要插入像一個新行粘貼之前，例如

'... 
findRange.InsertAfter vbCR 
findRange.Collapse wdCollapseEnd 
findRange.Paste