Recupérer et enregistrer tous les graphs d'un classeur excel
Soyez le premier à donner votre avis sur cette source.
Snippet vu 8 006 fois - Téléchargée 76 fois
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
- Recupérer et enregistrer tous les graphs d'un classeur excel
- Liaison entre vb et excel, récupération puis enregistrement en .txt - Codes sources - Visual Basic / VB.NET (Divers)
- Mysql - Recuperer les enregistrement répondant à un Array ✓ - Forum - SQL
- Recuperer données enrégistré les 10 dernières minutes ✓ - Forum - C# / .NET
- Recuperer et enregistrer un flux d'une webradio ✓ - Forum - C# / .NET
- Récupérer un enregistrement dans un datagrid ! ✓ - Forum - ASP / ASP.NET
Commentaires
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.
merci de m'aider SVP
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.