Mardi 23 novembre 2010 2 23 /11 /Nov /2010 10:13

Sub CREER_GRAPHIQUE()
' à partir d'un fichier à 5 colonnes
' ( 1 = identifiant serie,
'   2 = titre graphique,
'   3 = titre des abcisses,
'   4 = date,
'   5 = valeur)
' contenant n séries triées
' découpe les données par série, et pour chaque série :
' - copie les valeurs sur une nouvelle feuille
' - crée un graphique à partir de ces valeurs (avec le titre)
' - enregistre ce graphique au format pdf dans un répertoire donné
'   avec comme nom l'identifiant de la série
Dim WS As Worksheet
Dim i, k, l As Integer
Dim IdSerie As String

' k enregistre la ligne de début d'une série
k = 3

' WS est le feuille d'origine qui contient ttes les données
Set WS = ActiveWorkbook.ActiveSheet

' IdSerie contient la série en cours - permet de tester si on change de série
'
IdSerie = WS.Cells(2, 1)
' lecture de l'ensemble des données
' - préciser le nb de lignes et mettre FIN dans la dernière ligne du fichier
'   dans la 1ère col
'
For i = 3 To 17132
'
' sélection de la ligne
  WS.Rows(i).Select
'
' test du changement de série : dans ce cas il y a action
  If IdSerie <> WS.Cells(i, 1) Or WS.Cells(i, 1) = "FIN" Then
  '
  ' sélection des valeurs la série (col D et E)
  '
    Range("D" & k & ":E" & (i - 1)).Select
    WS.Range("D" & k & ":E" & (i - 1)).Copy
    ' ajout d'une feuille - nommée par l'id (col A)
    '
    Sheets.Add
    ActiveSheet.Name = IdSerie
    ' copie de la sélection
    ActiveSheet.Paste
    ' copie en ligne 1 des infos de titres
    WS.Range("A" & k & ":C" & k).Copy
    Selection.EntireRow.Insert
    '
    ' création et export du graphique en pdf
    '
    Charts.Add
    With ActiveChart
     .ChartType = xlLineMarkers
     .SetSourceData Source:=WS.Range("D" & k & ":E" & (i - 1)), PlotBy _
        :=xlColumns
        .Name = IdSerie & "_graph"
        .HasDataTable = False
        .HasTitle = True
        .ChartTitle.Characters.text = WS.Cells((i - 1), 2)
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.text = "date"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.text = WS.Cells((i - 1), 3)
        .Export Filename:="Q:\GRAPH\" & IdSerie & ".jpg", FilterName:="JPEG"
    End With
    ' mise à jour des variables pour la série suivante
    '
    k = i
    IdSerie = WS.Cells(i, 1)
    ' repositionnement sur la feuille initiale
    '
    WS.Activate
End If
Next
End Sub
'
'
'

Par memoprog - Publié dans : VISUALBASIC
Ecrire un commentaire - Voir les 0 commentaires
Retour à l'accueil

Présentation

Créer un Blog

Recherche

Calendrier

Mai 2012
L M M J V S D
  1 2 3 4 5 6
7 8 9 10 11 12 13
14 15 16 17 18 19 20
21 22 23 24 25 26 27
28 29 30 31      
<< < > >>
Créer un blog gratuit sur over-blog.com - Contact - C.G.U. - Rémunération en droits d'auteur - Signaler un abus