mercredi 26 août 2020

Loop through sheets and copy Charts to Word, VBA

I'm trying to write a macro that loops through all sheets in a excel workbook and if there is a chart It copy the chart to a new word document. The workbook consist of around 35 sheets and only half of them are populated with a chart. I want the code to jump to next sheet if there is no chart in it and if there is a chart copy it to Word and then move on to the next one. I am very new to VBA and coding in general and been experimenting a bit. I managed to get one chart from one sheet into word... I've tried a few different things and left that in as comments.

My code as today:


        '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

I'm sorry if it is a bit messy.

Aucun commentaire:

Enregistrer un commentaire