遍历工作表并将图表复制到 Word、VBA

Question

我正在尝试编写一个循环遍历 Excel 工作簿中所有工作表的宏，如果有图表，它会将图表复制到新的 Word 文档中。该工作簿由大约 35 张纸组成，其中只有一半装有图表。如果其中没有图表并且如果有图表将其复制到 Word，我希望代码跳转到下一张表，然后转到下一张表。 我对 VBA 和一般编码非常陌生，并且一直在进行一些实验。我设法将一张图表从一张纸变成了文字...... 我尝试了一些不同的东西，并将其保留为 cmets。

我今天的代码：

        'Declare word object variables
    Dim WordApp     As Word.Application
    Dim WordDoc     As Word.Document
    
        'Declare excel Object variable
    Dim WrkSht      As Worksheet
    Dim Chrt        As ChartObject
    Dim Cht_Sht     As Chart
    Dim wkBk        As Workbook
    
    
    'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False
    
        'Set the link to the location where the excel evaluation sheet is located, include file name in the link
   Const Utvärdering As String = "C:\Users\A561004\OneDrive - AF\Desktop\Test\Utvärdering.xlsx"
    
        'Open Excel Utvärdering...
    Application.StatusBar = "Utvärdering"
    Set wkBk = Workbooks.Open(Utvärdering)
    
        ' Select sheet based on name
    Sheets(1).Select
         
            
        'Create a new instance of Word
    Set WordApp = New Word.Application
        WordApp.Visible = True
        WordApp.Activate
        
        
        'Create a new word document
    Set WordDoc = WordApp.Documents.Add
            
            
        'Start a loop
        For Each WrkSht In Sheets
        'WrkSht.ChartObjects.Select
        
       If ActiveSheet.ChartObjects.Count > 0 Then
        
        For Each Cht_Sht In wkBk.Sheets(1).ChartObjects
            Cht_Sht.ChartArea.ChartArea.Copy
        
        'ActiveChart.ChartArea.Select
        'ActiveChart.ChartArea.Copy
        
            With Word.Application.Selection
       .PasteSpecial Link:=False, DataType:=15
       
           WordApp.ActiveDocument.Selections.Add
        'Go to new page
    WordApp.Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
        'Clear Clipboard
    Application.CutCopyMode = False
       
     End With
     
     Next Cht_Sht
    
        
    Else
        WrkSht.Next.Activate
    End If
        
        'Test loop
        'For each Cht_Sht in 2 To Sheets(ActiveWorkbook.Sheets.Count - 1)
        
     
    
        'Create a Reference to the chart you want to Export
    'ActiveChart.ChartArea.Select
    'On Error Resume Next
    'ActiveChart.ChartArea.Copy
    
    
    
        
        'Paus application 2 sek
    Application.Wait Now + #12:00:02 AM#
        
        
        'Paste into WOrd Document
    'With Word.Application.Selection
     '  .PasteSpecial Link:=False, DataType:=15
       
    ' End With
    
        'New word page Problems here, need to set a new marker in the document for next paste
   ' WordApp.ActiveDocument.Selections.Add
        'Go to new page
  '  WordApp.Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
        'Clear Clipboard
  ' Application.CutCopyMode = False
    
        'End loop, or start next rotation of loop
        Next WrkSht
        
        'Optimise Code
    Application.EnableEvents = True
    
    On Error GoTo 0
    
End Sub

如果有点乱，我很抱歉。

Answer 1

您错过了在 For Each WrkSht In Sheets 之后键入 WrkSht.Select 并删除 else 条件 这是更新的代码

For Each WrkSht In Sheets
    WrkSht.Select
    If WrkSht.ChartObjects.Count > 0 Then
        For Each Cht_Sht In wkBk.Sheets(1).ChartObjects
            Cht_Sht.ChartArea.ChartArea.Copy
             With Word.Application.Selection
                 .PasteSpecial Link:=False, DataType:=15
                 WordApp.ActiveDocument.Selections.Add
                 WordApp.Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext
                 Application.CutCopyMode = False
             End With
        Next Cht_Sht
    End If
 Next WrkSht

如果您得到想要的答案，请标记为答案并关闭话题。

Answer 2

您遍历所有工作表 (For Each WrkSht In Sheets)，但始终只检查第一张工作表：For Each Cht_Sht In wkBk.Sheets(1).ChartObjects。你应该寻找For Each Cht_Sht In wrkSht.ChartObjects。