2
votes

I have a macro which carries out the following logic in VBA in excel:

  1. Opens a word document

  2. Loop through all the pre set bookmarks in the document

  3. When a bookmark is found, loop through all the chart objects in a specific sheet, when the Chart Name matches the bookmark name, copy that into the word doc

I am running into Error 462 on the second run of the macro. I realise it's to do with not referencing an object properly but I cant seem to find where the culprit is.

My code looks like this:

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

My copyGraphs looks like:

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

The copyGraph Sub is in the same module as the sub that calls it.

1
Have you tried to close your Word docs before relaunching? Because if they are still open in another Word instance, I'm not sure you will be able to open them normally...R3uK
Hello, yes I have tried closing the entire excel file and re-opening. The same issue is still filtering through.clery00
Nope, I meant your Word's documents, because you don't close them in your code and if they are already open it might be the reason it's not working. Add wdDoc.Close at the end of your Sub copyGraphs and try it ;)R3uK
Apologies for the confusion, yes I am closing everything after the error is thrown. For what it's worth, on the second run, the 462 error is thrown, at wdApp.Selection.PasteSpecial DataType:=wdPasteEnhancedMetafile. The chart is pasted into the doc and then it crashes.clery00
Mkay... I guess you meant before the error, because if you close it manually after the error, there is no point... Have you tried to use Selection on wdDoc rather than on wdApp? And add a ByVal to each of your Arguments of copyGraphs as your doc will be modifiedR3uK

1 Answers

2
votes

Adding ByVal did in fact work, but required the excel sheet to be closed and reopened to clear all the objects from memory.

Credit @R3uK for the answer

The below code works:

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

Routine to copy graphs :

 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