Macro - Export Multiple Charts From Container To Excel

    Hello All,

     

    Once I struggled to export to all the charts in a container to excel file. I could not find correct code in the community. So I would like to share the below code which exports the charts into excel.

     

    Sub Export
    
      set oXL = CreateObject("Excel.Application")
    
      oXL.DisplayAlerts = False
      oXL.visible=True 'False ti hide the excel
      Dim oXLDoc 'as Excel.Workbook
      Dim i
    
       Set oXLDoc  = oXL.Workbooks.Add
    
        FilePath =  ActiveDocument.Variables("vPath").GetContent.String
        FileName =  oXLDoc.Name
    
      '---------------------------------------
      Set ContainerObj = ActiveDocument.GetSheetObject("CT01") 'Container ID
        Set ContProp=ContainerObj.GetProperties
      SheetObj=Array("CH01","CH02","CH03")                    'Chart ID's
      '---------------------------------------
    
      for i=0 to UBound(SheetObj)
    
      'ActiveDocument.GetApplication.WaitForIdle
    
      oXL.Sheets.Add
      oXL.ActiveSheet.Move ,oXL.Sheets( oXL.Sheets.Count )
    
         ContProp.SingleObjectActiveIndex = i
            ContainerObj.SetProperties ContProp
    
      Set oSH = oXL.ActiveSheet
         oSH.Range("A1").Select
    
         Set obj = ActiveDocument.GetSheetObject(SheetObj(i))
         obj.CopyTableToClipboard True
         oSH.Paste
         sCaption=obj.GetCaption.Name.v
         Set obj=Nothing
    
      oSH.Rows("1:1").Select
      oXL.Selection.Font.Bold = True
    
         oSH.Cells.Select
         oXL.Selection.Columns.AutoFit
    
         oSH.Range("A1").Select 
      oSH.Name=left(sCaption,30)
    
      Set oSH=Nothing
    
      Next
    '---------------------------------------
      Call Excel_DeleteBlankSheets(oXLDoc)
    '---------------------------------------
    
      oXL.DisplayAlerts = True
        oXLDoc.Sheets(1).Select
    
       If FilePath <>"" then
      oXLDoc.SaveAs FilePath & "\" & FileName & ".xlsx"
      Else
      Msgbox "Folder path can not be empty. Enter Valid path"
       End If
    
       oXLDoc.Close FALSE
       oXL.Quit
    
      Set oXL    =Nothing
      Set oXLDoc =Nothing
    End Sub
    
    '--------------------------------------------------------------------
    
    Private Sub Excel_DeleteBlankSheets(ByRef oXLDoc)
    
      For Each ws In oXLDoc.Worksheets
    
      If oXLDoc.Application.WorksheetFunction.CountA(ws.Cells) = 0 Then
      On Error Resume Next
         Call ws.Delete()
      End If
      Next
    
    End Sub
    
    '-------------------------------------------------------------------
    
    
    
    

     

    Press Ctrl-M to see Macro window, and make sure "System Access" and "Allow System Access" drop down boxes are selected at the left hand side. Change the container Id and chart Id's according to your requirement.

     

    Capture.PNG

    That's all.

    scriptina.jpg