Exporter tous les graphiques en tant que graphiques

Question

J'essaie de trouver un moyen d'exporter facilement tous les graphiques d'un classeur dans Excel en tant que graphiques. J'ai le code suivant:

Option Explicit 

Sub ExportChart() 
    ' Export a selected chart as a picture 
    Const sSlash$ = "/" 
    Const sPicType$ = ".png" 
    Dim sChartName$ 
    Dim sPath$ 
    Dim sBook$ 
    Dim objChart As ChartObject 


    On Error Resume Next 
    ' Test if there are even any embedded charts on the activesheet 
    ' If not, let the user know 
    Set objChart = ActiveSheet.ChartObjects(1) 
    If objChart Is Nothing Then 
    MsgBox "No charts have been detected on this sheet", 0 
    Exit Sub 
    End If 


    ' Test if there is a single chart selected 
    If ActiveChart Is Nothing Then 
    MsgBox "You must select a single chart for exporting ", 0 
    Exit Sub 
    End If 


Start: 
    sChartName = Application.InputBox("Please Specify a name for the exported chart" & vbCr & _ 
    "There is no default name available" & vbCr & _ 
    "The chart will be saved in the same folder as this file", "Chart Export", "") 

    ' User presses "OK" without entering a name 
    If sChartName = Empty Then 
    MsgBox "You have not entered a name for this chart", , "Invalid Entry" 
    GoTo Start 
    End If 

    ' Test for Cancel button 
    If sChartName = "False" Then 
    Exit Sub 
    End If 

    ' If a name was given, chart is exported as a picture in the same 
    ' folder location as their current file 
    sBook = ActiveWorkbook.Path 
    sPath = sBook & sSlash & sChartName & sPicType 
    ActiveChart.Export Filename:=sPath, FilterName:="PNG" 

End Sub 

Cela exporter le graphique actif, mais comment puis-je exporter tous les tableaux? Points bonus si les graphiques sont nommés d'après la feuille de calcul d'où ils proviennent.

Answer 1

Sub Test() 

Dim sht As Worksheet, cht As ChartObject 
Dim x As Integer 

    For Each sht In ActiveWorkbook.Sheets 
     x = 1 
     For Each cht In sht.ChartObjects 
      cht.Chart.Export "C:\local files\temp\" & sht.Name _ 
           & "_" & x & ".png", "PNG" 
      x = x + 1 
     Next cht 

    Next sht 

End Sub 

Answer 2

Rapide et sale.
Vous souhaitez placer ceci au bas de votre code pour faire défiler les feuilles de calcul et tous les objets de graphique sur chaque feuille.

Je n'ai pas testé cela car je n'ai pas le temps de recréer vos fichiers ou votre situation. Espérons que cela aide

For each x in worksheets.count then 
    For Each objChart In ActiveSheet.ChartObjects then 
    sChartName = activesheet.name 
    sBook = ActiveWorkbook.Path 
    sPath = sBook & sSlash & sChartName & sPicType 
    ActiveChart.Export Filename:=sPath, FilterName:="PNG" 
    Next objChart 
Next x