Suche nach einem Text in Word und Einfügen von Daten nach dem

Question

Ich habe folgende VBA-Skript, um Daten von Excel-Arbeitsblättern in Word zu kopieren. Das funktioniert gut.

Jetzt vor dem Einfügen möchte ich den Namen des Blattes im Word-Dokument suchen und die entsprechenden Daten darunter einfügen. Bisher habe ich die Suchfunktion in mein Skript aufgenommen, bin mir aber nicht sicher, wie ich weiter vorgehen soll.

Können Sie bitte führen, wie bekomme ich die Position des gefundenen Textes und machen Sie die Paste danach einfügen?

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

Versuchen Sie, diese

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 

Natürlich möchten Sie vielleicht so etwas wie eine neue Zeile einzufügen vor dem Einfügen, z.B.

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