通过 VBA 粘贴在 Excel 和 Word 之间不起作用

Question

我有一个工作簿，它根据工作簿中的 Word 模板和表格创建 Word 报告。

根据设备类型，它会从电子表格中复制一个范围并将其粘贴到 word 文档中的两个书签位置（bmInternal 和 bmExternal）。我尝试使用 PasteAppendTable，但这只能工作一次。如果我尝试使用它两次，对于每个书签，它两次都不会复制任何内容。因此，我将 Paste 用作一个，PasteAppendTable 用作第二个（PasteAppendTable 更整洁，因为格式更好）。

这工作正常，但我对代码进行了更改，与此无关，现在粘贴（转到 bmInternal）不起作用。当我没有更改关于该部分的任何内容时，我不明白为什么：

Sub Data2Word()

Application.GoTo Reference:=ActiveSheet.Range("A2")

GoAgain:
On Error Resume Next
Dim vItem As String
'Dim vImagePath As String

Dim vCurrentRow As Integer

Dim vDesc As String
Dim vN2 As String
Dim vGuide As String
Dim vUnit As String
Dim vBlock As String

Dim wrdPic As Word.InlineShape
Dim rng As Excel.Range                    'our source range
Dim rngText As Variant
Dim rngText2 As Variant

Dim wdApp As New Word.Application   'a new instance of Word
Dim wdDoc As Word.Document          'our new Word template
Dim myWordFile As String            'path to Word template
Dim wsExcel As Worksheet
Dim tmpAut

'Find Item and type
vItem = ActiveCell.Value
vDesc = ActiveCell.Offset(0, 2)
vN2 = ActiveCell.Offset(0, 1)
vGuide = ActiveCell.Offset(0, 3)
vBlock = ActiveCell.Offset(0, 4)
vUnit = Left(vItem, 3)

If ActiveSheet.Range("rngREPORTED") = "Yes" Then
    MsgBox vItem & " already has a report."
    Exit Sub
End If
'initialize the Word template path
'here, it's set to be in the same directory as our source workbook
myWordFile = "W:\Entity\Inspect\WORD\INSPECTION TEMPLATES\Inspection Template - 20160511.dotx"

'open a new word document from the template
Set wdDoc = wdApp.Documents.Add(myWordFile)

If vGuide = "IGE01" Then

    rngText = "rngEXCH"
    rngText2 = "rngEXCHE"

ElseIf ActiveCell.Offset(, 4) = "Mono" Then

    'Do Mono
    rngText = "rngMONO"

Else

        ActiveWorkbook.Names.Add Name:="rngItemSub", RefersTo:=Worksheets("SubEquipment").Range("B" & ActiveCell.Offset(0, 6) & ":C" & ActiveCell.Offset(0, 7) + ActiveCell.Offset(0, 6))

CarryOn:
        rngText = "rngItemSub"

End If

'Insert Tables
'get the range of the data

Set rng = Range(rngText)
rng.Copy                            'copy the range

wdDoc.Bookmarks("bmInternal").Range.Paste 'AppendTable

If vGuide = "IGE01" Then
    Set rng = Range(rngText2)
    rng.Copy
End If

wdDoc.Bookmarks("bmExternal").Range.PasteAppendTable

wdDoc.Bookmarks("bmItem").Range.InsertAfter vItem
wdDoc.Bookmarks("bmDesc").Range.InsertAfter vDesc
wdDoc.Bookmarks("bmN2").Range.InsertAfter vN2
wdDoc.Bookmarks("bmGuide").Range.InsertAfter vGuide
wdDoc.Bookmarks("bmBlock").Range.InsertAfter vBlock

wdDoc.Variables("wvItem").Value = vItem
ActiveDocument.Fields.Update

With wdDoc
        Set wrdPic = .Bookmarks("bmImage").Range.InlineShapes.AddOLEObject(ClassType:="AcroExch.Document.7", Filename:="W:\Entity\Inspect\T&I\2016\Various Items\Photos\Sorted\" & vItem & ".pdf", LinkToFile:=False, DisplayAsIcon:=False)
        wrdPic.ScaleHeight = 55
        wrdPic.ScaleWidth = 55
End With

wdApp.Visible = True

wdApp.Activate

wdDoc.SaveAs "W:\Entity\Inspect\WSDATA\REPORTS\2016\" & vUnit & "\" & vItem & " " & vN2 & " THO.docx" 'Mid(ActiveDocument.Name, 1, Len(ActiveDocument.Name) - 4)

MoveHere:

ActiveWorkbook.Sheets("AllItems").Range("G" & ActiveCell.Offset(0, 8)).Value = "Yes"
ActiveWorkbook.Save

End Sub

Answer 1

我认为 DocVariables 更容易使用书签。在 Word DocVariables 上进行快速 Google 搜索。在 Word 中进行正确设置，然后运行下面的脚本。

Sub PushToWord()

Dim objWord As New Word.Application
Dim doc As Word.Document
Dim bkmk As Word.Bookmark
sWdFileName = Application.GetOpenFilename(, , , , False)
Set doc = objWord.Documents.Open(sWdFileName)
'On Error Resume Next

objWord.ActiveDocument.variables("FirstName").Value = Range("FirstName").Value
objWord.ActiveDocument.variables("LastName").Value = Range("LastName").Value
objWord.ActiveDocument.variables("AnotherVariable").Value = Range("AnotherVariable").Value


objWord.ActiveDocument.Fields.Update

'On Error Resume Next
objWord.Visible = True

End Sub