XL 2010 Amélioration code pour convertir objet en .png

Dario

XLDnaute Nouveau
Bonjour le forum,

J'ai un onglet données ainsi qu'un nommées TDC_Stat.

J'aimerai améliorer le code VBA ci dessous afin qu'il puisse également convertir format PNG les images ainsi que les objets sur l'onglet 'TDC_Stat' à ce jour il converti les graphiques.

Code:
-------------------------------------------------
Sub Générer_Les_Images_du_classeur()

Dim NomChart, NomFeuille As String
Dim Nomfichier As String, Nb As Long
Dim A As Long, Répertoire As String
Dim Feuille As Worksheet

Application.ScreenUpdating = False
Application.EnableEvents = False
Répertoire = "C:\Users\dario\Desktop\encours\"
'Répertoire = "\\intranet....\Nouveau dossier\"

For Each Feuille In ThisWorkbook.Worksheets
    With Feuille
        NomFeuille = .Name
        With .ChartObjects
            Nb = .Count
            For A = 1 To Nb
                NomChart = .Item(A).Name
                Nomfichier = Répertoire & NomChart & ".png"
                Call CréerImage(NomChart, NomFeuille, Nomfichier)
            Next
        End With
    End With
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

'-------------------------------------------------
Sub CréerImage(NomChart, NomFeuille As String, _
            Nomfichier As String)
Dim Sh As Worksheet

Application.ScreenUpdating = False
With Worksheets(NomFeuille)
    .Shapes(NomChart).Copy
    Set Sh = Worksheets.Add
    With Sh
        .Paste
        With .ChartObjects.Add(0, 0, _
                Selection.Width, Selection.Height).Chart
            .Paste
            .ChartArea.Border.LineStyle = 0
        End With
        With .ChartObjects(1)
            .Top = 0
            .Left = 0
            .Chart.Export Nomfichier, "PNG"
        End With
        Application.DisplayAlerts = False
        Sh.Delete
        Application.DisplayAlerts = True
    End With
End With

End Sub
'-------------------------------------------------


l'idée serait de créer plusieurs photos format PNG lorsque je lance ma sauvegarde du fichier puis fermeture du classeur

Merci de votre aide

PS liens si besoin

Le lien a été crée :
 

Discussions similaires

Statistiques des forums

Discussions
312 321
Messages
2 087 265
Membres
103 501
dernier inscrit
talebafia