USINE A GRAPHIQUE

[vatounet]

Salut à tous

Après avoir posé plein de questions et avoir obtenu pas mal de réponses, voila ma petite contribution au forum.
Une usine à graphique, pour repeter X fois le même graph et les exporter en image.
Elle marche tres bien sur mon ordi, j'espere que s'il elle vous interesse elle focntionnera chez vous.

Le code :

Sub activ3()

Dim i As Long
Dim x As Long
Sheets(1).Select
i = 2

Do Until Cells(i, 1).Value = ''
Cells(i, 1).Activate
    x = 1
    Do While ActiveCell.Value = ActiveCell.Offset(x, 0).Value
        x = x + 1
    Loop
    Sheets('Feuil2').Select
    Range('A2:D26').Select
    Selection.ClearContents
    Sheets('Feuil1').Select
    With ActiveSheet
        Application.Intersect(.Range(ActiveCell, ActiveCell.Offset(x - 1, 0).EntireRow), .UsedRange).Select
    End With
    Selection.Copy
    Sheets('Feuil2').Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Application.Run 'graphauto.xls!export'
i = i + x
Sheets(1).Select
Loop

End Sub

Sub export()
'
' export Macro
' Macro enregistrée le 05/08/2005 par sigdbn
'
    Dim Graph As ChartObject
    Dim NomFichier As String

NomFichier = Sheets(2).Range('E2') & ' ' & Format(Date, 'yyyy mm dd') & '_' & Format(Time, 'hh mm ss')

Set Graph = Sheets(2).ChartObjects(1)
Graph.Chart.export 'D:\\Mes documents\\Bases de donnees\\EXPORT GRAPHIQUE\\' & NomFichier & '.gif', 'GIF'

End Sub

Et le fichier exemple xls zippé en piece jointe.
Avant de lancer la machine créer un dossier pour recevoir les .gif des graphiques, chez moi c'est D\\mes documents\\Bases de donnees\\EXPORT GRAPHIQUE.

Un petit hic encore (voir la piece jointe), si il n'y a qu'une seule date par station, le graph se met à jour bizarrement.

Un grand merci au FORUM à TITCOEUR, DIDIER MDF, MICHEL XLD...EXCELABO et le FORUM HARDWARE.fr
En fait je suis trop content, j'y connais rien en vba et sa marche quand même.

A+
et merci encore

Fred
[file name=graphauto.zip size=14192]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/graphauto.zip[/file]

 

[MichelXld]

bonsoir Fred

merci pour ton message et de faire partager ton travail sur le forum

cela fonctionne tres bien chez moi ( Excel2002)

j'ai juste adapté le chemin de sauvegarde des images :
'D:\\Mes documents\\Bases de donnees\\EXPORT GRAPHIQUE\\'


bon week end
MichelXld