I'm writing some VBA code to export some charts from Excel to a bookmark in a Word document that is already open. It's meant to send the charts from only sheets in Excel that contain ".atf" in the name, ignoring the other sheets. It inserts the charts at the bookmark in reverse order, as the number of sheets with charts will vary and each set of charts should be on their own page. However, what happens is that only the charts from the first sheet that contains ".atf" get copied and pasted repeatedly for the total number of sheets. Can someone help get this running correctly? Any other improvements also gratefully received!

Here's my code:

Private Sub CommandButton3_Click()

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .DisplayAlerts = False
    .DisplayStatusBar = False
End With

Dim WS As Worksheet
Dim appWD As Object, wddoc As Object
Dim check As Boolean

Set appWD = GetObject(, "Word.Application")
Set wddoc = appWD.Documents(1)
wddoc.Application.ScreenUpdating = False

For Each WS In Worksheets
    'Export figures unless none present
    If WS.Name Like "*.atf" Then check = True: Exit For
Next

    If check = True Then
        For i = Sheets.Count To 1 Step -1
            If WS.Name Like "*.atf" Then
                
                Word.Application.Documents(1).Activate
                wddoc.Bookmarks("qfigs1").Range.Select
                    
                With wddoc.ActiveWindow.Selection
                    .Collapse Direction:=wdCollapseStart
                    .InsertBreak Type:=wdPageBreak
                    .Font.Bold = True
                    .TypeText Text:="File "
                    .TypeText WS.Range("A2").Value
                    .TypeText Text:=" Recording Quality Figures"
                    .InsertParagraph
                End With
                    
                WS.ChartObjects("Chart 3").Copy
                With wddoc
                    .ActiveWindow.Selection.Collapse Direction:=wdCollapseStart
                    .ActiveWindow.Selection.InsertParagraph
                    .ActiveWindow.Selection.Collapse Direction:=wdCollapseStart
                    .ActiveWindow.Selection.Range.PasteSpecial _
                        DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, _
                        Link:=False, DisplayAsIcon:=False
                    .ActiveWindow.Selection.Collapse Direction:=wdCollapseStart
                    .ActiveWindow.Selection.InsertParagraph
                    .Application.CutCopyMode = False
                End With

                WS.ChartObjects("Chart 2").Copy
                With wddoc
                    .ActiveWindow.Selection.Collapse Direction:=wdCollapseStart
                    .ActiveWindow.Selection.InsertParagraph
                    .ActiveWindow.Selection.Collapse Direction:=wdCollapseStart
                    .ActiveWindow.Selection.Range.PasteSpecial _
                        DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, _
                        Link:=False, DisplayAsIcon:=False
                    .ActiveWindow.Selection.Collapse Direction:=wdCollapseStart
                    .ActiveWindow.Selection.InsertParagraph
                    .Application.CutCopyMode = False
                End With
                    
                WS.ChartObjects("Chart 1").Copy
                With wddoc
                    .ActiveWindow.Selection.Collapse Direction:=wdCollapseStart
                    .ActiveWindow.Selection.InsertParagraph
                    .ActiveWindow.Selection.Collapse Direction:=wdCollapseStart
                    .ActiveWindow.Selection.Range.PasteSpecial _
                        DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, _
                        Link:=False, DisplayAsIcon:=False
                    .ActiveWindow.Selection.Collapse Direction:=wdCollapseStart
                    .ActiveWindow.Selection.InsertParagraph
                    .Application.CutCopyMode = False
                End With
                    
            ElseIf WS.Name Like "*.atf" = False Then
                Resume Next
            
            End If
        Next
    Else
        MsgBox "No figures to export"
        Exit Sub
    End If

wddoc.Application.ScreenUpdating = True
Set wddoc = Nothing

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .DisplayAlerts = True
    .DisplayStatusBar = True
End With

MsgBox "All figures exported"

End Sub

CodePudding user response：

Solution:

Add Set WS = Sheets(i) after this line For i = Sheets.Count To 1 Step -1

Also consider:

• Sheets and Worksheets are not quite the same. (see Define sheets and worksheets in VBA).

  In your case you probably want to use Worksheets.

• Remove the ElseIf, you don't need it.

• Remove the check above, you don't need it.

• Fix the indentation of the For i loop.

• The block of code for copying charts repeats, so you can do

Dim ChartName As Variant

For Each ChartName In Array("Chart 3", "Chart 2", "Chart 1")
    WS.ChartObjects(ChartName).Copy
    With wddoc.ActiveWindow.Selection.Collapse Direction:=wdCollapseStart
         .ActiveWindow.Selection.InsertParagraph
         .ActiveWindow.Selection.Collapse Direction:=wdCollapseStart
         .ActiveWindow.Selection.Range.PasteSpecial _
             DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, _
             Link:=False, DisplayAsIcon:=False
         .ActiveWindow.Selection.Collapse Direction:=wdCollapseStart
         .ActiveWindow.Selection.InsertParagraph
         .Application.CutCopyMode = False
    End With
Next