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

Question

我有一个宏，它在 excel 的 VBA 中执行以下逻辑:

打开一个word文档

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

找到书签后，遍历特定工作表中的所有图表对象，当图表名称与书签名称匹配时，将其复制到单词 doc

我在第二次运行宏时遇到错误 462。我意识到这与没有正确引用对象有关，但我似乎无法找到罪魁祸首。

我的代码如下所示:

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

错误退出:

wdDoc.Close
wdApp.Quit

Set wdApp = Nothing
Set wdDoc = Nothing

Exit Sub

错误处理程序:

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 与调用它的 sub 在同一个模块中。

Answer 1

添加 ByVal 确实有效，但需要关闭并重新打开 Excel 工作表以清除内存中的所有对象。

信用@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