Question

我有以下VBA脚本将数据从Excel工作表复制到word。这很好。

现在在粘贴之前，我想在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

在单词中查找文本并在其后插入数据

1 个答案: