Einfügen funktioniert nicht zwischen Excel und Word über VBA

Question

Ich habe eine Arbeitsmappe, die Word-Berichte basierend auf einer Word-Vorlage und Tabellen in der Arbeitsmappe erstellt.

Je nach Gerätetyp wird ein Bereich aus der Tabelle kopiert und an zwei Lesezeichen im Word-Dokument eingefügt (bmInternal und bmExternal). Ich habe versucht, PasteAppendTable zu verwenden, aber das funktioniert nur einmal. Wenn ich versuche, es zweimal für jedes Lesezeichen zu verwenden, kopiert es nichts beide Male. Als solche habe ich Paste für eine und PasteAppendTable für die zweite (PasteAppendTable ist viel besser, als die Formatierung ist besser).

Das hat gut funktioniert, aber ich habe Änderungen am Code vorgenommen, nicht verwandt damit, und jetzt funktioniert die Paste (die zu bmInternal geht) nicht. Ich kann nicht sehen, warum, wenn ich nichts in Bezug auf diesen Teil geändert haben:

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

Ich denke DocVariables einfacher sind, dass Lesezeichen zu verwenden. Machen Sie eine schnelle Google-Suche auf Word DocVariables. Ermitteln Sie in Word die richtigen Einstellungen, und führen Sie das folgende Skript aus.

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