将图表从Excel粘贴到Word错误 – 远程服务器计算机不存在(错误462)

我有一个macros在Excel中的VBA中执行以下逻辑:

  1. 打开一个文件

  2. 循环浏览文档中的所有预设书签

  3. 当find书签时,循环浏览特定工作表中的所有图表对象,当图表名称与书签名称相匹配时,将其复制到word文档中

我正在运行到macros的第二次运行错误462。 我意识到这是与不正确引用一个对象,但我似乎无法find罪魁祸首。

我的代码如下所示:

Sub buildDocument() '#### Initialise our variables Dim wdApp As Word.Application Dim wdDoc As Word.Document Dim theWorksheet As Worksheet Dim Chart As ChartObject Dim wdBookmarksArray() As Variant Dim counter1 As Integer Dim counter2 As Integer Dim noCharts As Integer Dim counter4 As Integer Dim PasteObect As Variant Dim quarter As String Dim sheetsArr As String '#### Switch off update #### Application.ScreenUpdating = False '#### Create a new word doc; minimise; #### Set wdApp = New Word.Application With wdApp .Visible = True .WindowState = wdWindowStateMinimize End With On Error GoTo ErrorHandler '#### Build a dialog box to find the ' correct word template file #### Set wdDoc = wdApp.Documents.Open(openDialog()) counter2 = 1 counter3 = 1 For counter1 = 1 To wdDoc.Bookmarks.Count '#### Export "New Issue Timing" graphs to ' word document #### Call copyGraphs(newIssuesTiming, _ counter1, _ wdDoc, _ wdApp) Next ThisWorkbook.sheets(mainSheet).Select Set wdApp = Nothing Set wdDoc = Nothing Exit Sub 

ErrorExit:

 wdDoc.Close wdApp.Quit Set wdApp = Nothing Set wdDoc = Nothing Exit Sub 

的ErrorHandler:

 Dim error_report As ErrorControl Set error_report = New ErrorControl error_report.SetErrorDetail = Err.Description error_report.SetErrorNumber = Err.Number error_report.SetErrorSection = "BUILD_WORD_DOC" If error_report.GenerateErrorReport Then Resume ErrorExit End If Set error_report = Nothing 

我的copyGraphs看起来像:

 Sub copyGraphs(sheet As String, _ counter1 As Integer, _ wdDoc As Word.Document, _ wdApp As Word.Application) Dim wdBookmarksArray() As Variant Dim counter2 As Integer Dim Chart As ChartObject Dim theWorksheet As Worksheet Dim noCharts As Integer Dim counter4 As Integer Dim PasteObect As Variant Dim quarter As String Dim sheetsArr As String For Each Chart In ThisWorkbook.sheets(sheet).ChartObjects If wdDoc.Bookmarks(counter1).name = Chart.name Then ThisWorkbook.sheets(sheet).ChartObjects(Chart.name).Copy wdApp.Selection.Goto What:=wdGoToBookmark, name:=wdDoc.Bookmarks(counter1).name wdApp.Selection.PasteSpecial DataType:=wdPasteEnhancedMetafile End If Next End Sub 

copyGraph Sub与调用它的子模块在同一个模块中。

添加ByVal确实起作用,但需要closures并重新打开Excel表格以清除内存中的所有对象。

Credit @ R3uK的答案

以下代码工作:

 Sub buildDocument() '#### Initialise our variables Dim wdApp As Word.Application Dim wdDoc As Word.Document Dim theWorksheet As Worksheet Dim Chart As ChartObject Dim wdBookmarksArray() As Variant Dim counter1 As Integer Dim counter2 As Integer Dim noCharts As Integer Dim counter4 As Integer Dim PasteObect As Variant Dim quarter As String Dim sheetsArr As String '#### Switch off update #### Application.ScreenUpdating = False '#### Create a new word doc; minimise; #### Set wdApp = New Word.Application With wdApp .Visible = True .WindowState = wdWindowStateMinimize End With On Error GoTo ErrorHandler '#### Build a dialog box to find the ' correct word template file #### Set wdDoc = wdApp.Documents.Open(openDialog()) counter2 = 1 counter3 = 1 For counter1 = 1 To wdDoc.Bookmarks.Count '#### Export "New Issue Timing" graphs to ' word document #### Call copyGraphs(newIssuesTiming, _ counter1, _ wdDoc, _ wdApp) Next ThisWorkbook.sheets(mainSheet).Select wdDoc.Save wdDoc.Close wdApp.Quit Set wdApp = Nothing Set wdDoc = Nothing Exit Sub ErrorExit: wdDoc.Close wdApp.Quit Set wdApp = Nothing Set wdDoc = Nothing Exit Sub ErrorHandler: Dim error_report As ErrorControl Set error_report = New ErrorControl error_report.SetErrorDetail = Err.Description error_report.SetErrorNumber = Err.Number error_report.SetErrorSection = "BUILD_WORD_DOC" If error_report.GenerateErrorReport Then Resume ErrorExit End If Set error_report = Nothing End Sub 

常规复制图表:

  Sub copyGraphs(ByVal sheet As String, _ ByVal counter1 As Integer, _ ByVal wdDoc As Word.Document, _ ByVal wdApp As Word.Application) Dim wdBookmarksArray() As Variant Dim counter2 As Integer Dim Chart As ChartObject Dim theWorksheet As Worksheet Dim noCharts As Integer Dim counter4 As Integer Dim PasteObect As Variant Dim quarter As String Dim sheetsArr As String For Each Chart In ThisWorkbook.sheets(sheet).ChartObjects If wdDoc.Bookmarks(counter1).name = Chart.name Then ThisWorkbook.sheets(sheet).ChartObjects(Chart.name).Copy ThisWorkbook.sheets(sheet).ChartObjects(Chart.name).Copy wdApp.Selection.Goto What:=wdGoToBookmark, name:=wdDoc.Bookmarks(counter1).name wdApp.Selection.PasteSpecial DataType:=wdPasteEnhancedMetafile End If Next End Sub