2016-06-01 132 views
0

我有一個基於Word模板和工作簿中的表創建Word報表的工作簿。通過VBA在Excel和Word之間粘貼不起作用

根據設備類型,它會複製電子表格中的一個範圍,並將其粘貼到Word文檔(bmInternal和bmExternal)中的兩個書籤位置。我嘗試使用PasteAppendTable,但這隻能使用一次。如果我嘗試使用它兩次,對於每個書籤,它都不會複製任何內容。因此,我使用Paste for one和PasteAppendTable for第二種方法(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 
+0

「不能正常工作」的描述不夠充分,請告訴我們拋出了什麼錯誤。 –

+2

刪除'On Error Resume Next'並查看它的功能。這告訴它如果出現錯誤而不是暫停並通知您,就繼續前進。 – arcadeprecinct

+0

@arcadeprecinct:啊!是的好主意! –

回答

0

我認爲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