RECUPÉRER ET ENREGISTRER TOUS LES GRAPHS D'UN CLASSEUR EXCEL

Signaler
Messages postés
35
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
15 septembre 2004
-
Messages postés
35
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
15 septembre 2004
-
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/227-recuperer-et-enregistrer-tous-les-graphs-d-un-classeur-excel

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.
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.
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