RECUPÉRER ET ENREGISTRER TOUS LES GRAPHS D'UN CLASSEUR EXCEL
skyzofrenzz
Messages postés
35
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
15 septembre 2004
-
4 févr. 2003 à 11:46
skyzofrenzz Messages postés 35 Date d'inscription jeudi 19 décembre 2002 Statut Membre Dernière intervention 15 septembre 2004 - 5 févr. 2003 à 23:30
skyzofrenzz Messages postés 35 Date d'inscription jeudi 19 décembre 2002 Statut Membre Dernière intervention 15 septembre 2004 - 5 févr. 2003 à 23:30
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
https://codes-sources.commentcamarche.net/source/227-recuperer-et-enregistrer-tous-les-graphs-d-un-classeur-excel
5 févr. 2003 à 23:30
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.
4 févr. 2003 à 19:37
4 févr. 2003 à 11:46
merci de m'aider SVP