2016-08-30 45 views
1

我有以下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 
+0

这比excel-vba更word-vba。你应该制作一个[最小,完整和可验证的示例](http://stackoverflow.com/help/mcve),它将在word-vba中并相应标记。 – arcadeprecinct

回答

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 
相关问题