Recupérer et enregistrer tous les graphs d'un classeur excel

Soyez le premier à donner votre avis sur cette source.

Snippet vu 7 980 fois - Téléchargée 76 fois

Commenter

Contenu du snippet


Source / Exemple : 


nb = Worksheets.Count
ext = ".gif"
numeroimage = 1
    For i = 1 To nb
        Sheets(i).Select
        nb1 = ActiveSheet.ChartObjects.Count
            If nb1 > 0 Then
                For l = 1 To nb1
                    ActiveSheet.ChartObjects(l).Activate
                    ' sauvegarde des charts
                    ActiveChart.Export Filename:="c:\basket\essai\image" & numeroimage & ext, filtername:="gif"
                    numeroimage = numeroimage + 1
                Next l
            End If
    Next i

A voir également

Ajouter un commentaire

Commentaires

Signaler
skyzofrenzz
Messages postés
35
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
15 septembre 2004
 -
voila mon code source:
Public Tjmax As Variant
Public Rthrad As Variant
Public Pd As Variant

Const FichierXLS = "courbes.xls"
Const CHART_HIDDEN = 1E+308
'Dim Worksheets As Excel.Chart
Dim xlApp As excel.Application
Dim xlBook As excel.Workbook
Dim xlRang As excel.Range
Dim xlSheet As excel.Worksheet
Dim i As Long

Private Sub Command3_Click()
'On Error GoTo et2
'Création de l'objet EXCEL 8.0
Set xlApp = New excel.Application
xlApp.Visible = False
With xlApp
'Ouverture du document XLS
Set xlBook = .Workbooks.Open(FileName:=App.Path + "" + FichierXLS, ReadOnly:=False, Editable:=True)
'Séléction de la feuille 1
Set xlSheet = xlBook.Worksheets(1)
End With

With xlSheet
.Range("H31").Value = Adodc1.Recordset.Fields("Maxrth")
'Modification de la zone nom
'une zone nom doit exister dans le template
'Set xlRang = .Range("nom")
'xlRang.Cells(1, 1) = txtNom

'modification des valeurs
'valeur est une zone de 10 cellule de haut
'Set xlRang = .Range("valeur")
'For i = 1 To 10
' xlRang.Cells(i, 1) = CLng(txtValue(i - 1))
' Next



End With
'Impression du document
' xlBook.PrintOut


nb = Worksheets.Count
ext = ".gif"
numeroimage = 1
For i = 1 To nb
Sheets(i).Select
nb1 = ActiveSheet.ChartObjects.Count
If nb1 > 0 Then
For l = 1 To nb1
ActiveSheet.ChartObjects(l).Activate
' sauvegarde des charts
ActiveChart.Export FileName:=App.Path + "" & numeroimage & ext, filtername:="gif"
numeroimage = numeroimage + 1
Next l
Picture2.Picture = LoadPicture("2.gif")
End If
Next i

'et2:
'Ferme le template XLS sans le sauvegarder

xlBook.Close savechanges:=False
'Quitte l'instance EXCEL crée
xlApp.Quit

Set xlRang = Nothing
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

End Sub

Ca marche bien le premier coup que je click sur command3 mais lorsque je reclique pour charger un autre graphique, ca me met """ erreur d'écution 1004 : La methode 'Worksheets de l'objet_Global a échoué.

A mon avis ce vient aussi que lorsque je click sur ALT CTRL SUPP j'ai trj l'application EXEL.exe et ca vient appement de ton code source car qand je l'enleve ca remarche et EXCEL.exe s'arrete.

Si tu a une solution Merci d'avance.
Signaler
jraynald
Messages postés
45
Date d'inscription
lundi 1 mai 2000
Statut
Membre
Dernière intervention
25 février 2012
 -
dis moi exactement ce que tu veux faire, car chez moi ça fonctionne nickel.
Signaler
skyzofrenzz
Messages postés
35
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
15 septembre 2004
 -
Ta source est tres bien, mais une fois insérer dans mon code, le la fait executer avec un bouton et je fait apparaitre l'image sauvegarder dans une picture box, le probleme est que lorsque je reclique j'ai un message d'erreur. je suis obliger de quitter le prog et le relancer !!!!
merci de m'aider SVP
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (jraynald)