IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

comment programmer un graphique en bâton et en camembert sur vba? [XL-2003]


Sujet :

Macros et VBA Excel

  1. #1
    Membre confirmé
    Profil pro
    Inscrit en
    Février 2011
    Messages
    70
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 70
    Par défaut comment programmer un graphique en bâton et en camembert sur vba?
    Bonjour,
    Etant débutant en programmation sur VBA, j'ai un problème. c'est pourquoi je me tourne vers vous.
    le but est de generer un premier graphique en bâton dont l'axe des abscisse est la date de mutation et l'ordonnée le nombre de personne par date de mutation. i.e nbr pers = f(date de mutation). Et Le deuxième graphe est un camembert dont le pourcentage par service de mutation. J'ai commence à rediger une macro pleine de fautes.
    Cette macro illustre d'une manière générale ce que je veux faire. Seulement , elle contient plusieurs erreurs dont je suis incapable de déboguer.
    1. La première partie de ma macro consiste à effacer automatiquement la feuille graphe qui a été générée avant. Pour cela j'ai fait des sous routines. il y a bug.
    2.Par la suite, je suis aller récupérer et compte le nombre de personnes désirant être mutée par période et par service. (je pense sur cette partie tout va bien. Par contre, je parviens à bien rédiger la matrice me permettant d'avoir mon graphe en bâton pour ce qui est nbre. pers = f(période) et pourcentage de personne voulant être mutée par direction.
    Vous trouverez ci dessous ma macro et ses sous-routines, je remercie toute personne de bonne volonté pouvant me sortir de cette galère

    ==================================================
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    Option Explicit
     
    Sub CreateChart()
    Dim Plage As Range
    Dim direction_mutation() As Variant
    Dim periode_mutation() As Variant
    Dim PossDirection() As Variant, PossPeriode() As Variant
    Dim i As Integer, j As Integer, nl As Integer
    Dim nligne As Integer
    Dim itrimestre As Integer
    Dim myexcelfile As String
    Dim chemin As String
    Dim tableau() As String
    Dim tableau2() As Integer
    Dim merde As String
     
     
     
    chemin = ThisWorkbook.Path
     
    myexcelfile = ThisWorkbook.Name
     
    ' mysheet =
    ' Set xlBook = Workbooks.Open(chemin & "\" & myexcelfile)
    ' Set xlSheet = xlBook.Sheets("S1UET1")
     
    Charts.Add
     
     
     
     
    MsgBox "pouet"
    ' !!!!!!!!!!!!!! avant de commencer il faut supprimer toutes les feuilles graphiques
    'récupération des directions de mutation
     
    Set Plage = Range("C2:C" & Range("C65536").End(xlUp).Row + 1)
    direction_mutation = Plage.Value
     
    'récupération des valeurs possibles des directions en utilisant la fonction qui supprime les doublons
    ReDim PossDirection(UBound(direction_mutation, 1))
    For i = 1 To UBound(direction_mutation, 1)
    PossDirection(i) = direction_mutation(i, 1)
    Next i
    PossDirection = SupprimerDoublons(PossDirection)
     
     
    ' récupération des trimestres et années de mutation
    Set Plage = Range("B2:B" & Range("B65536").End(xlUp).Row + 1)
    periode_mutation = Plage.Value
     
    ReDim PossPeriode(UBound(periode_mutation, 1))
    For i = 1 To UBound(periode_mutation, 1)
    PossPeriode(i) = periode_mutation(i, 1)
    Next i
    PossPeriode = SupprimerDoublons(PossPeriode)
     
     
    ReDim Mutant(UBound(PossDirection), UBound(PossPeriode))
    For i = 1 To UBound(PossDirection)
    For j = 1 To UBound(PossPeriode)
    Mutant(i, j) = 0
    Next j
    Next i
     
     
    For nligne = 1 To UBound(direction_mutation, 1)
     
    For i = 1 To UBound(PossDirection)
    For j = 1 To UBound(PossPeriode)
    If (direction_mutation(nligne, 1) = PossDirection(i)) Then
    If (periode_mutation(nligne, 1) = PossPeriode(j)) Then
    Mutant(i, j) = Mutant(i, j) + 1
    End If
    End If
     
     
    Next j
    Next i
    Next nligne
     
     
    'graph pour le T1-2012
    For i = 1 To UBound(PossPeriode)
    If PossPeriode(i) = "T1-2012" Then
    itrimestre = i
    End If
    Next i
    MsgBox "so farsogood"
     
     
     
    'MsgBox tableau(1)
     
    With ActiveChart
    .SeriesCollection.NewSeries
    .SeriesCollection(1).XValues = periode_mutation() 'Abscisses
    .SeriesCollection(1).Values = PossDirection() 'Ordonnées
    'Définit le type (Courbe)
    .ChartType = xlColumnClustered
    End With
     
     
     
     
     
     
     
     
     
     
     
    ' 1ère étape: on lit la colonne des directions et on détermine les directions possibles
     
    ' Select the cell in the upper-left corner of the chart.
    ' Range("c4").Select
    ' Select the current range of data. This line of code assumes that
    ' the current region of cells is contiguous - without empty rows
    ' or columns.
    ' Selection.CurrentRegion.Select
     
    ' Assign the address of the selected range of cells to a variable.
    ' myrange = Selection.Address
     
     
     
     
     
    ' Application.CutCopyMode = False
     
    ' This line can best be written by recording a macro, and
    ' modifying the code generated by the Microsoft Excel Macro
    ' recorder.
     
    ' ActiveChart.ChartWizard _
    ' Source:=Sheets(mysheetname).Range(myrange), _
    ' Gallery:=xlLine, Format:=4, PlotBy:=xlRows, _
    ' CategoryLabels:=1, SeriesLabels:=1, HasLegend:=1, _
    ' Title:="", CategoryTitle:="", _
    ' ValueTitle:="", ExtraTitle:=""
     
    End Function
     
     
    Function SupprimerDoublons(tbl()) As Variant()
     
    Dim Dico As Object
    Dim Cle
    Dim T()
    Dim i As Long
     
    'crée l'objet
     
    Set Dico = CreateObject("Scripting.Dictionary")
     
    'inscrit les valeurs dans le dictionnaire
    'en affectant aussi cette valeur à la clé
    'une clé devant être unique, si on ne contrôle pas
    'son existance dans la collection, un erreur est générée
    For i = 1 To UBound(tbl)
    If Dico.Exists(tbl(i)) = False Then
    Dico.Add tbl(i), tbl(i)
    End If
    Next i
     
    i = 0
     
    'tranfert des valeurs uniques dans un tableau
    For Each Cle In Dico.keys
    i = i + 1
    ReDim Preserve T(1 To i)
    T(i) = Cle
    Next
     
     
     
     
    'passage de ce tableau à la fonction
    SupprimerDoublons = T
     
    'libère la mémoire
    Set Dico = Nothing
     
    End Function
     
    Sub nettoieFeuilleGraph(fichier As String)
    Dim test As Boolean
    Dim n As Integer
    Dim i As Integer
     
     
     
    Application.DisplayAlerts = False
    Set xlBook = Workbooks.Open(fichier)
    MsgBox Worksheets.Count
    n = Worksheets.Count
    For i = 1 To n
     
    test = WsExist("Graph" + Str(i))
    MsgBox test
     
    If test = True Then
    Worksheets("Graph" + Str(i)).Delete
    End If
     
     
     
    Next i
    Application.DisplayAlerts = True
    ActiveWorkbook.Save
     
    End Sub
     
    Function WsExist(nomFeuil As String) As Boolean
    On Error Resume Next
    WsExist = Sheets(nomFeuil).Index
    End Function
    =========================================


    Je vous remercie d'avance.

  2. #2
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    Bonjour,

    il y a bug
    Oui. Sur quelle ligne; quel est le message d'erreur ?

  3. #3
    Membre confirmé
    Profil pro
    Inscrit en
    Février 2011
    Messages
    70
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 70
    Par défaut
    C'est juste le problème sur ma macro. En effet elle ne signale pas d'erreur (pas un message d'erreurs )mais par contre elle exécute des choses qui n'ont rien à voir avec ce que je veux faire. par, elle ouvre une fenêtre de graphe mais celle-ci est vide. si j'exécute de nouveau le programme, elle ne supprime pas l'ancienne fenêtre alors cela a été écrite.
    Le graphe en soit, n'est pas du tout tracé
    J'ai illustré mon besoin par un petit exemple que tu pourras voir sur le fichier excel en pièce jointe.

    Merci d'avance de vous soucier de mon cas
    Fichiers attachés Fichiers attachés

  4. #4
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    Tu essaies de faire un graphique avec les variables "Tableau" en abscisse et "Tableau2" en ordonnées. Or, nulle part, tu ne remplis ces variables. Que veux-tu mettre dans ton graphique ? Donne-moi les plages de cellules.

  5. #5
    Membre confirmé
    Profil pro
    Inscrit en
    Février 2011
    Messages
    70
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 70
    Par défaut
    je veux faire un premier graphe en bâton montrant le nombre de personne mutée en fonction la date de mutation.
    Le second graphe (un camembert) est la répartition en pourcentage par service de mutation.

  6. #6
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    Regarde cette macro qui crée le premier graphique. Dis-moi si c'est correct :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    Sub CreateChart2()
        Dim Plage As Range
        Dim direction_mutation As Variant
        Dim periode_mutation As Variant
        Dim PossDirection As Variant, PossPeriode As Variant
        Dim i As Integer, j As Integer, nl As Integer
        Dim nligne As Integer
        Dim itrimestre As Integer
        Dim myexcelfile As String
        Dim chemin As String
        Dim sh
     
       chemin = ThisWorkbook.Path
       myexcelfile = ThisWorkbook.Name
       For Each sh In Sheets
           If Left(sh.Name, 5) = "GRAPH" Then sh.Delete
       Next sh
     
     
        Charts.Add
     
        Set Plage = Range("C2:C" & Range("C65536").End(xlUp).Row)
        PossDirection = Application.Transpose(Plage.Value)
     
        'récupération des valeurs possibles des directions en utilisant la fonction qui supprime les doublons
        PossDirection = SupprimerDoublons(PossDirection)
     
     
        ' récupération des trimestres et années de mutation
        Set Plage = Range("B2:B" & Range("B65536").End(xlUp).Row)
        PossPeriode = Application.Transpose(Plage.Value)
     
        PossPeriode = SupprimerDoublons(PossPeriode)
        Dim tableau() As Long
        ReDim tableau(1 To UBound(PossPeriode))
        For i = 1 To UBound(PossPeriode)
            tableau(i) = Application.CountIf(Plage, PossPeriode(i))
        Next i
        With ActiveChart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = PossPeriode  'Abscisses
            .SeriesCollection(1).Values = tableau 'Ordonnées
            'Définit le type (Courbe)
            .ChartType = xlColumnClustered
        End With
     
     End Sub
    ... et avec le camembert :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    Sub CreateChart2()
        Dim Plage As Range
        Dim direction_mutation As Variant
        Dim periode_mutation As Variant
        Dim PossDirection As Variant, PossPeriode As Variant
        Dim i As Integer, j As Integer, nl As Integer
        Dim nligne As Integer
        Dim itrimestre As Integer
        Dim myexcelfile As String
        Dim chemin As String
        Dim sh
     
       chemin = ThisWorkbook.Path
       myexcelfile = ThisWorkbook.Name
       Application.DisplayAlerts = False
       For Each sh In Sheets
           If Left(sh.Name, 5) = "Graph" Then sh.Delete
       Next sh
       Application.DisplayAlerts = True
     
        Charts.Add
     
        Set Plage = Range("C2:C" & Range("C65536").End(xlUp).Row)
        PossDirection = Application.Transpose(Plage.Value)
     
        'récupération des valeurs possibles des directions en utilisant la fonction qui supprime les doublons
        PossDirection = SupprimerDoublons(PossDirection)
     
     
        ' récupération des trimestres et années de mutation
        Set Plage = Range("B2:B" & Range("B65536").End(xlUp).Row)
        PossPeriode = Application.Transpose(Plage.Value)
     
        PossPeriode = SupprimerDoublons(PossPeriode)
        Dim tableau() As Double
        ReDim tableau(1 To UBound(PossPeriode))
        For i = 1 To UBound(PossPeriode)
            tableau(i) = Application.CountIf(Plage, PossPeriode(i))
        Next i
        With ActiveChart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = PossPeriode  'Abscisses
            .SeriesCollection(1).Values = tableau 'Ordonnées
            'Définit le type (Courbe)
            .ChartType = xlColumnClustered
        End With
        ReDim tableau(1 To UBound(PossDirection))
        Set Plage = Plage.Offset(, 1)
        For i = 1 To UBound(PossDirection)
            tableau(i) = Application.CountIf(Plage, PossDirection(i)) / UBound(PossDirection)
        Next i
        Charts.Add
        With ActiveChart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = PossDirection  'Abscisses
            .SeriesCollection(1).Values = tableau 'Ordonnées
            'Définit le type (Courbe)
            .ChartType = xlPie
        End With
     End Sub

  7. #7
    Membre confirmé
    Profil pro
    Inscrit en
    Février 2011
    Messages
    70
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 70
    Par défaut
    Merci Daniel pour ta réponse, j'ai modifié un peu ta proposition pour obtenir ce que je voulais. cependant j'ai 3 nouveaux problèmes qui se posent.
    1. je voudrais faire afficher par période croissante au niveau des abscisse sur mon graphe en bâton. par exple. de T1-2012 à T4-2013
    2. le graphe camembert doit contenir uniquement la répartition par service de mutation de la plus petite année. Expl. Dans le graphe bâton, 2012 est la plus petite année, alors l'on récupère les données de celle-ci et fait un camembert par service de mutation.
    3. faire afficher sur mon graphe camembert à l’intérieur de répartition le nom de service de mutation et leur pourcentage.
    Tu trouvera en dessous la version améliorer de ma macro.

    merci d'avance

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    Sub CreateChart()
        Dim Plage As Range
        Dim PossDirection() As Variant, PossPeriode() As Variant
        Dim listeDirection() As Variant, listeMetier() As Variant
        Dim i As Integer, j As Integer, nl As Integer, nligne As Integer
        Dim myrange As String, mysheetname As String
        Dim shtoto As Worksheet
        Dim tmp() As Variant
        Dim d As Double
     
     
        If WsExist("result") = True Then
             Worksheets("result").Delete
        End If
     
        For Each sh In Sheets
           If Left(sh.Name, 5) = "Graph" Then sh.Delete
       Next sh
     
     
     
     
        'récupération des directions de mutation
     
        Set Plage = Range("C2:C" & Range("C65536").End(xlUp).Row)
        PossDirection = Application.Transpose(Plage.Value)
        listeDirection = PossDirection
        PossDirection = SupprimerDoublons(PossDirection)
     
        ' récupération des listes métiers
        Set Plage = Range("D2:D" & Range("D65536").End(xlUp).Row)
        listeMetier = Application.Transpose(Plage.Value)
        listeMetier = SupprimerDoublons(listeMetier)
     
        ' récupération des trimestres et années de mutation
        Set Plage = Range("B2:B" & Range("B65536").End(xlUp).Row)
        PossPeriode = Application.Transpose(Plage.Value)
        PossPeriode = SupprimerDoublons(PossPeriode)
     
     
     
     
        ' PossPeriode = range_croissant(PossPeriode)
     
     
        ' Graph Bâton
        Charts.Add
        Dim tableau() As Long
        ReDim tableau(1 To UBound(PossPeriode))
        For i = 1 To UBound(PossPeriode)
            tableau(i) = Application.CountIf(Plage, PossPeriode(i))
        Next i
        With ActiveChart
            'SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = PossPeriode  'Abscisses
            .SeriesCollection(1).Values = tableau 'Ordonnées
            .ChartType = xlColumnClustered   'type de graph
        End With
     
     
        ' Camembert
        ' il faudra sélectionner ceux qui vont muter dans la prochaine année
        ' il faut remplir différemment le tableau
        Dim tableau2() As Double
        ReDim tableau2(1 To UBound(PossDirection))
        d = 1 / UBound(PossDirection)
        Set Plage = Plage.Offset(, 1)
        For i = 1 To UBound(PossDirection)
            tableau2(i) = Application.CountIf(Plage, PossDirection(i)) * d
        Next i
     
        Charts.Add
        With ActiveChart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = PossDirection  'Abscisses
            .SeriesCollection(1).Values = tableau2 'Ordonnées
            .ChartType = xlPie
        End With
     
     
        'camembert de la DCT
        ' récupération des métiers de la DCT
        ncount = 0
        For i = 1 To UBound(listeDirection)
           If listeDirection(i) = "DCT" Then
                ncount = ncount + 1
            End If
        Next i
     
     
        ReDim tbl(ncount)
        ncount = 0
        For i = 1 To UBound(listeDirection)
           If listeDirection(i) = "DCT" Then
                ncount = ncount + 1
                tbl(ncount) = listeMetier(i)
            End If
        Next i
        sous_tableDCT = tbl
        tbl = SupprimerDoublons(tbl)
     
     
      ' créer le tableau 2
     
       ReDim tableau2(1 To UBound(tbl))
        d = 1 / UBound(tbl)
        Set Plage = Plage.Offset(, 1)
       For i = 1 To UBound(tbl)
            tableau2(i) = Application.CountIf(sous_tableDCT, tbl(i)) * d
        Next i
       '
       Charts.Add
        With ActiveChart
        '    .SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = tbl  'Abscisses
          .SeriesCollection(1).Values = tableau2 'Ordonnées
            .ChartType = xlPie
       End With
     
     
     End Sub
     
     
    Function SupprimerDoublons(tbl()) As Variant()
     
        Dim Dico As Object
        Dim Cle
        Dim T()
        Dim i As Long
     
        'crée l'objet
     
        Set Dico = CreateObject("Scripting.Dictionary")
     
        'inscrit les valeurs dans le dictionnaire
        'en affectant aussi cette valeur à la clé
        'une clé devant être unique, si on ne contrôle pas
        'son existance dans la collection, un erreur est générée
        For i = 1 To UBound(tbl)
            If Dico.Exists(tbl(i)) = False Then
                Dico.Add tbl(i), tbl(i)
            End If
        Next i
     
        i = 0
     
        'tranfert des valeurs uniques dans un tableau
        For Each Cle In Dico.keys
            i = i + 1
            ReDim Preserve T(1 To i)
            T(i) = Cle
        Next
     
     
     
     
        'passage de ce tableau à la fonction
        SupprimerDoublons = T
     
        'libère la mémoire
        Set Dico = Nothing
     
    End Function
     
     
     Function WsExist(nomFeuil As String) As Boolean
    On Error Resume Next
    WsExist = Sheets(nomFeuil).Index
       End Function
     
     
       Function range_croissant(tbl()) As Variant()
        Dim tmp() As Variant
        Dim tmp1() As String
        Dim trim() As Variant
        Dim min_an As Integer
        Dim max_an As Integer
        Dim trimes(4) As String, annees() As String
     
     
        trimes(1) = "T1-"
        trimes(2) = "T2-"
        trimes(3) = "T3-"
        trimes(4) = "T4-"
        MsgBox tbl(1)
        ReDim tmp1(UBound(tbl))
        For i = 1 To UBound(tbl)
            tmp1(i) = Split(Str(tbl(i)), "-")
        Next i
        ' chercher le min d'année
        ' chercher le max d'année
        min_an = 21000
        max_an = 2000
     
       For i = 1 To UBound(tmp1, 1)
            If Val(tmp1(i, 2)) < min_an Then
                min_an = Val(tmp1(i, 2))
            End If
            If Val(tmp1(i, 2)) < max_an Then
                max_an = Val(tmp1(i, 2))
            End If
        Next i
     
        nannees = max_an - min_an + 1
        ReDim annees(nannees)
        For i = 1 To nannees
            annees(i) = Str(min_an + (i - 1))
            MsgBox annees(i)
        Next i
     
        ncount = 0
        For i = 1 To nannees
            For j = 1 To 4
                For k = 1 To UBound(tbl)
                    If tbl(k) = trimes(j) & annees(i) Then
                        ncount = ncount + 1
                        tmp(ncount) = tbl(k)
                        MsgBox tmp(ncount)
                    End If
     
                Next k
            Next j
        Next i
     
     
       range_croissant = tmp
       End Function
     
    Function sans_zero(tbl()) As Variant()
        Dim ih As Integer
        Dim nn As Integer
        Dim i As Integer
        Dim T()
     
     
     
            ih = 0
            For i = 1 To UBound(tbl)
                If tbl(i) <> 0 Or tbl(i) <> " " Or tbl(i) <> "0" Then
                    ih = ih + 1
                End If
            Next i
        ReDim T(ih)
            nn = 0
            For i = 1 To UBound(tbl)
                If tbl(i) <> 0 Or tbl(i) <> " " Or tbl(i) <> "0" Then
                    nn = nn + 1
                    T(nn) = tbl(i)
                End If
            Next i
     
        sans_zero = T
     
     
    End Function

  8. #8
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    Essaie cette macro :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    Sub CreateChart()
        Dim Plage As Range
        Dim PossDirection() As Variant, PossPeriode() As Variant
        Dim listeDirection() As Variant, listeMetier() As Variant
        Dim i As Integer, j As Integer, nl As Integer, nligne As Integer
        Dim myrange As String, mysheetname As String
        Dim shtoto As Worksheet
        Dim tmp() As Variant
        Dim d As Double
        Dim c As Range
     
        Application.DisplayAlerts = False
        If WsExist("result") = True Then
             Worksheets("result").Delete
        End If
     
        For Each sh In Sheets
           If Left(sh.Name, 5) = "Graph" Then sh.Delete
       Next sh
        Application.DisplayAlerts = True
     
     
     
        'récupération des directions de mutation
     
        Set Plage = Range("C2:C" & Range("C65536").End(xlUp).Row)
        PossDirection = Application.Transpose(Plage.Value)
        listeDirection = PossDirection
        PossDirection = SupprimerDoublons(PossDirection)
     
        ' récupération des listes métiers
        Set Plage = Range("D2:D" & Range("D65536").End(xlUp).Row)
        listeMetier = Application.Transpose(Plage.Value)
        listeMetier = SupprimerDoublons(listeMetier)
     
        ' récupération des trimestres et années de mutation
        Set Plage = Range("B1:B" & Range("B65536").End(xlUp).Row)
        [M:O].ClearContents
        Plage.AdvancedFilter xlFilterCopy, copytorange:=[M1], unique:=True
        For Each c In Range([M2], Cells(Rows.Count, 13).End(xlUp))
            c.Offset(, 1) = Left(c.Value, 2)
            c.Offset(, 2) = CInt(Right(c.Value, 4))
        Next c
        Range([N2], Cells(Rows.Count, 15).End(xlUp)).Select
        Range([N2], Cells(Rows.Count, 15).End(xlUp)).Sort [O2], xlAscending, key2:=[N2], order2:=xlAscending, header:=xlNo
        Range([N2], Cells(Rows.Count, 15).End(xlUp)).Copy
        [N2].PasteSpecial xlPasteValues
        For Each c In Range([M2], Cells(Rows.Count, 13).End(xlUp))
            c.Value = c.Offset(, 1) & "-" & c.Offset(, 2)
            c.Offset(, 2) = CInt(Right(c.Value, 4))
        Next c
        PossPeriode = Application.Transpose(Range([M2], Cells(Rows.Count, 13).End(xlUp)).Value)
     
     
     
        ' PossPeriode = range_croissant(PossPeriode)
     
     
        ' Graph Bâton
        Charts.Add
        Dim tableau() As Long
        ReDim tableau(1 To UBound(PossPeriode))
        For i = 1 To UBound(PossPeriode)
            tableau(i) = Application.CountIf(Plage, PossPeriode(i))
        Next i
        With ActiveChart
            'SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = PossPeriode  'Abscisses
            .SeriesCollection(1).Values = tableau 'Ordonnées
            .ChartType = xlColumnClustered   'type de graph
        End With
     
     
        ' Camembert
        ' il faudra sélectionner ceux qui vont muter dans la prochaine année
        ' il faut remplir différemment le tableau
        Dim tableau2() As Double
     
    ReDim tableau2(1 To UBound(PossDirection))
        d = 1 / UBound(PossDirection)
        For i = 2 To Plage.Count
            If CInt(Right(Cells(i, 2), 4)) = [O2].Value Then
                tableau2(Application.Match(Cells(i, 3).Value, PossDirection, 0)) = _
                tableau2(Application.Match(Cells(i, 3).Value, PossDirection, 0)) + 1
            End If
        Next i
     
        Charts.Add
        With ActiveChart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = PossDirection  'Abscisses
            .SeriesCollection(1).Values = tableau2 'Ordonnées
            .ChartType = xlPie
            .HasLegend = False
            .SeriesCollection(1).ApplyDataLabels AutoText:=True, LegendKey:= _
                False, HasLeaderLines:=True, ShowSeriesName:=False, ShowCategoryName:= _
                True, ShowValue:=False, ShowPercentage:=True, ShowBubbleSize:=False
            With .SeriesCollection(1).DataLabels
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .ReadingOrder = xlContext
                .Position = xlLabelPositionCenter
                .Orientation = xlHorizontal
            End With
            With .SeriesCollection(1)
                p = .Values
                For i = 1 To .Points.Count
                    If p(i) = 0 Then .Points(i).DataLabel.Delete
                Next
            End With
        End With
     
     
        'camembert de la DCT
        ' récupération des métiers de la DCT
        ncount = 0
        For i = 1 To UBound(listeDirection)
           If listeDirection(i) = "DCT" Then
                ncount = ncount + 1
            End If
        Next i
     
     
        ReDim tbl(ncount)
        ncount = 0
        For i = 1 To UBound(listeDirection)
           If listeDirection(i) = "DCT" Then
                ncount = ncount + 1
                tbl(ncount) = listeMetier(i)
            End If
        Next i
        sous_tableDCT = tbl
        tbl = SupprimerDoublons(tbl)
     
     
      ' créer le tableau 2
     
       ReDim tableau2(1 To UBound(tbl))
        d = 1 / UBound(tbl)
        Set Plage = Plage.Offset(, 1)
       For i = 1 To UBound(tbl)
            tableau2(i) = Application.CountIf(sous_tableDCT, tbl(i)) * d
        Next i
       '
       Charts.Add
        With ActiveChart
        '    .SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = tbl  'Abscisses
          .SeriesCollection(1).Values = tableau2 'Ordonnées
            .ChartType = xlPie
       End With
        [M:O].ClearContents
     
     End Sub

  9. #9
    Membre confirmé
    Profil pro
    Inscrit en
    Février 2011
    Messages
    70
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 70
    Par défaut
    Bonjour Daniel,
    je suis desolé de n'avoir pas pu te répondre hier.
    il y a 2 problèmes avec ta macro:
    1 je me rends compte qu'elle ecrit les resultats dans la feuille de données. En realite, cette feuille est standard, i.e non modifiable. n'est pas possible de faire classification et ranger le nbre de mutant par année croissante directement?

    2 il y a un bug sur cette ligne de code de ta macro, que je ne crompreds pas
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    If CInt(Right(Cells(i, 2), 4)) = [O2].Value Then
    merci

  10. #10
    Membre confirmé
    Profil pro
    Inscrit en
    Février 2011
    Messages
    70
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 70
    Par défaut
    Rebonjour Daniel,
    J'ai un petit problème dans cette macro pour le copier coller d'un classeur à un autre(celle-ci n'a rien à voir avec celui du graphe).
    ci-dessus , tu trouveras la macro et le probleme se trouve sur la ligne :ActiveSheet.Paste
    Tout me semble pourtant correct
    merci


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    Sub COPIEBASEVG()
     
    Workbooks.Open Filename:="C:\Documents and Settings\Desktop\ModeleSimple\Service1\UET1.xls"
    '  Sheets("S1UET1").Activate
    '  Range("A2:D7").Copy
    Workbooks.Open Filename:="C:\Documents and Settings\Desktop\ModeleSimple\Service1\Service1.xls"
    'Windows("detail.xls").Activate
    '  Sheets("feuille de detail").Activate
    '  Range("C9").Select
    '  ActiveSheet.Paste
    Windows("UET1.xls").Activate
      Sheets("S1UET1").Activate
      Range("B2:D7").Copy
    Workbooks.Open Filename:="C:\Documents and Settings\Desktop\ModeleSimple\Service1\Service1.xls"
     
    Windows("Service1.xls").Activate
      Sheets("feuille de detail").Activate
      Range("D9").Select
      ActiveSheet.Paste
    'Windows("export.xls").Close
    'Windows("essai copie fichier2.xls").Close
      'Sheets("MENU").Select
     
    End Sub

  11. #11
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    En réponse du 20/11/11 11:03 :

    Est-ce que tu testes avec le classeur que tu m'as fait parvenir ? quel est le message d'erreur ?

    1 je me rends compte qu'elle ecrit les resultats dans la feuille de données. En realite, cette feuille est standard, i.e non modifiable. n'est pas possible de faire classification et ranger le nbre de mutant par année croissante directement?
    Bien sûr, mais c'est beaucoup plus compliqué. Je vais ajouter une feuille que je supprimerai en fin de macro.

    En réponse du 20/11/11 11:59 :

    Ouvre un nouveau fil pour cette question. Je ne pourrai pas la traiter aujourd'hui.

  12. #12
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Pour ouvrir 2 classeurs, copier des données de l'un vers l'autre, enregistrer le 2ème et fermer les 2. Il est recommandé de travailler avec des variables sans rien activer ni sélectionner

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    Sub COPIEBASEVG()
    Dim Wbk As Workbook, Wbks As Workbook
    Dim Rep As String
     
     
    Rep = "C:\Documents and Settings\Desktop\ModeleSimple\Service1\"
    Set Wbk = Workbooks.Open(Rep & "UET1.xls")
    Set Wbks = Workbooks.Open(Rep & "Service1.xls")
     
    Wbk.Worksheets("S1UET1").Range("B2:D7").Copy Wbks.Worksheets("feuille de detail").Range("D9")
     
    Wbk.Close False
    Wbks.Close True
    Set Wbk = Nothing
    Set Wbks = Nothing
    End Sub

  13. #13
    Membre confirmé
    Profil pro
    Inscrit en
    Février 2011
    Messages
    70
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 70
    Par défaut
    Merci Mercatog,

    Cette routine fonctionne très bien. Par contre, certaines cellules qu'on copie sont des menus déroulants. Quand on exécute la macro, un message d'erreur nous dit que le fichier de destination contient déjà les mots-clés du fichier source. Comment faire pour ne plus avoir ce message?

  14. #14
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    Je n'ai pas compris, mais 2 variantes

    1. remplace la ligne 10 par celle-ci
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Wbks.Worksheets("feuille de detail").Range("D9:F14").Value = Wbk.Worksheets("S1UET1").Range("B2:D7").Value
    2. désactive les alertes autour de la ligne 10
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    Application.DisplayAlerts = False
    Wbk.Worksheets("S1UET1").Range("B2:D7").Copy Wbks.Worksheets("feuille de detail").Range("D9")
    Application.DisplayAlerts = True

  15. #15
    Membre confirmé
    Profil pro
    Inscrit en
    Février 2011
    Messages
    70
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 70
    Par défaut
    Bonjour Daniel et autres,
    J'ai bidouillé et finalement trouver la solution me permettant de générer mes graphes. Mais seulement, en voulant faire le troisième graphe qui consiste à faire une répartition graphique des métiers de la "DCT" au cours de l'année minimale

    Il y a un bug que je n'arrive pas à trouver la solution. Pourras-tu jeter un coup d'oeil sur ma macro ci-dessous, et me délivrer de cette souffrance?

    merci par avance

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    Sub CreateChartPouet(feuille As String)
        Dim Plage As Range
        Dim PossDirection() As Variant, PossPeriode() As Variant, PossMetier() As Variant
        Dim SPossPeriode() As Variant
        Dim listeDirection() As Variant, listeMetier() As Variant
        Dim i As Integer, j As Integer, nl As Integer, nligne As Integer
        Dim myrange As String, mysheetname As String
        Dim shtoto As Worksheet
        Dim tmp() As Variant
        Dim d As Double
        Dim c As Range
        Dim test() As String
        Dim tableau2() As Double
     
     
     
        For Each sh In Sheets
           If Left(sh.Name, 5) = "Graph" Then sh.Delete
       Next sh
        Application.DisplayAlerts = True
     
        Worksheets(feuille).Activate
     
     
     
        'récupération des directions de mutation
     
        Set Plage = Range("C2:C" & Range("C65536").End(xlUp).Row)
        PossDirection = Application.Transpose(Plage.Value)
        listeDirection = PossDirection
        PossDirection = SupprimerDoublons(PossDirection)
     
     
     
        ' récupération des listes métiers
        Set Plage = Range("D2:D" & Range("D65536").End(xlUp).Row)
        listeMetier = Application.Transpose(Plage.Value)
        listeMetier = PossMetier
        PossMetier = SupprimerDoublons(PossMetier)
     
     
        ' récupération des trimestres et années de mutation
        Set Plage = Range("B2:B" & Range("B65536").End(xlUp).Row)
        PossPeriode = Application.Transpose(Plage.Value)
        listeperiode = PossPeriode
        PossPeriode = SupprimerDoublons(PossPeriode)
        SPossPeriode = range_croissant(PossPeriode)
        For i = 1 To UBound(PossPeriode)
            PossPeriode(i) = SPossPeriode(i)
        Next i
        ' Graph Bâton
        Charts.Add
        Dim tableau() As Long
        ReDim tableau(1 To UBound(PossPeriode))
        For i = 1 To UBound(PossPeriode)
            tableau(i) = Application.CountIf(Plage, PossPeriode(i))
        Next i
        With ActiveChart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = PossPeriode  'Abscisses
            .SeriesCollection(1).Values = tableau 'Ordonnées
            .ChartType = xlColumnClustered   'type de graph
        End With
     
     
     
        possannee1 = premiere_annee(PossPeriode)
     
        ncount = 0
        For i = 1 To UBound(listeperiode)
            For j = 1 To UBound(possannee1)
                If listeperiode(i) = possannee1(j) Then
                    ncount = ncount + 1
                End If
            Next j
        Next i
     
     
        ReDim dirannee1(1 To ncount)
        ncount = 0
        For i = 1 To UBound(listeperiode)
            For j = 1 To UBound(possannee1)
                If listeperiode(i) = possannee1(j) Then
                    ncount = ncount + 1
                    dirannee1(ncount) = listeDirection(i)
                End If
            Next j
     
        Next i
     
       ReDim tableau2(UBound(PossDirection))
       For i = 1 To UBound(dirannee1)
        For j = 1 To UBound(PossDirection)
            If dirannee1(i) = PossDirection(j) Then
                MsgBox "direction"
                MsgBox dirannee1(i)
                MsgBox PossDirection(j)
                tableau2(j) = tableau2(j) + 1
            End If
        Next j
        Next i
     
     
       ' For i = 1 To UBound(tableau2)
       '     tableau2(j) = tableau2(j) / UBound(tableau2)
       ' Next i
     
     
     
     
     
       ' PossPeriode
     
     
        ' Camembert
        ' il faudra sélectionner ceux qui vont muter dans la prochaine année
        ' il faut remplir différemment le tableau
       ' Dim tableau2() As Double
     
       ' ReDim tableau2(1 To UBound(PossDirection))
       ' d = 1 / UBound(PossDirection)
       ' For i = 2 To Plage.Count
      '      If CInt(Right(Cells(i, 2), 4)) = [O2].Value Then
       '         tableau2(Application.Match(Cells(i, 3).Value, PossDirection, 0)) = _
                tableau2(Application.Match(Cells(i, 3).Value, PossDirection, 0)) + 1
       '     End If
       ' Next i
     
        Charts.Add
        With ActiveChart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = PossDirection  'Abscisses
            .SeriesCollection(1).Values = tableau2 'Ordonnées
            .ChartType = xlPie
            .HasLegend = False
            .SeriesCollection(1).ApplyDataLabels AutoText:=True, LegendKey:= _
                False, HasLeaderLines:=True, ShowSeriesName:=False, ShowCategoryName:= _
                True, ShowValue:=True, ShowPercentage:=False, ShowBubbleSize:=False, Separator _
            :="" & Chr(10) & ""
            With .SeriesCollection(1).DataLabels
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .ReadingOrder = xlContext
                .Position = xlLabelPositionCenter
                .Orientation = xlHorizontal
            End With
            With .SeriesCollection(1)
                p = .Values
                For i = 1 To .Points.Count
                    If p(i) = 0 Then .Points(i).DataLabel.Delete
                Next
            End With
        End With
     
     
        MsgBox "fin du camembert"
     
     
        'camembert de la DCT
        ' récupération des métiers de la DCT
        ncount = 0
        For i = 1 To UBound(listeDirection)
           If listeDirection(i) = "DCT" Then
                ncount = ncount + 1
            End If
        Next i
     
     
        ReDim tbl(ncount)
        ncount = 0
        For i = 1 To UBound(listeDirection)
           If listeDirection(i) = "DCT" Then
                ncount = ncount + 1
                tbl(ncount) = listeMetier(i)
            End If
        Next i
        sous_tableDCT = tbl
        tbl = SupprimerDoublons(tbl)
     
     
      ' créer le tableau 2
     
       ReDim tableau2(1 To UBound(tbl))
        d = 1 / UBound(tbl)
        Set Plage = Plage.Offset(, 1)
       For i = 1 To UBound(tbl)
            tableau2(i) = Application.CountIf(sous_tableDCT, tbl(i)) * d
        Next i
     
     
        '
       Charts.Add
        With ActiveChart
        '    .SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = tbl()  'Abscisses
          .SeriesCollection(1).Values = tableau2 'Ordonnées
            .ChartType = xlPie
       End With
        [M:O].ClearContents
     
     End Sub
     
     
     
     
    Function SupprimerDoublons(tbl()) As Variant()
     
        Dim Dico As Object
        Dim Cle
        Dim T()
        Dim i As Long
     
        'crée l'objet
     
        Set Dico = CreateObject("Scripting.Dictionary")
     
        'inscrit les valeurs dans le dictionnaire
        'en affectant aussi cette valeur à la clé
        'une clé devant être unique, si on ne contrôle pas
        'son existance dans la collection, un erreur est générée
        For i = 1 To UBound(tbl)
            If Dico.Exists(tbl(i)) = False Then
                Dico.Add tbl(i), tbl(i)
            End If
        Next i
     
        i = 0
     
        'tranfert des valeurs uniques dans un tableau
        For Each Cle In Dico.keys
            i = i + 1
            ReDim Preserve T(1 To i)
            T(i) = Cle
        Next
     
     
     
     
        'passage de ce tableau à la fonction
        SupprimerDoublons = T
     
        'libère la mémoire
        Set Dico = Nothing
     
    End Function
     
     
     Function WsExist(nomFeuil As String) As Boolean
    On Error Resume Next
    WsExist = Sheets(nomFeuil).Index
       End Function
     
     
     
     
    Function sans_zero(tbl()) As Variant()
        Dim ih As Integer
        Dim nn As Integer
        Dim i As Integer
        Dim T()
     
     
     
            ih = 0
            For i = 1 To UBound(tbl)
                If tbl(i) <> 0 Or tbl(i) <> " " Or tbl(i) <> "0" Then
                    ih = ih + 1
                End If
            Next i
        ReDim T(ih)
            nn = 0
            For i = 1 To UBound(tbl)
                If tbl(i) <> 0 Or tbl(i) <> " " Or tbl(i) <> "0" Then
                    nn = nn + 1
                    T(nn) = tbl(i)
                End If
            Next i
     
        sans_zero = T
     
     
    End Function
     
     
     Function range_croissant(tbl()) As Variant()
        Dim tmp() As Variant
        Dim tmp1() As String
        Dim tmp2() As String
     
        Dim trim() As String
        Dim annee() As String
        Dim min_an As Integer
        Dim max_an As Integer
        Dim annees() As String
        Dim ndim As Integer
        Dim trimestre2D() As Integer
     
     
        ndim = UBound(tbl)
     
     
        ReDim trim(ndim)
        ReDim annee(ndim)
        For i = 1 To ndim
            tmp1 = Split(tbl(i), "-")
            tmp2 = Split(tmp1(0), "T")
            trim(i) = tmp2(1)
            annee(i) = tmp1(1)
        Next i
     
        min_an = min_annee(tbl)
        max_an = max_annee(tbl)
     
        ReDim trimestre2D(max_an - min_an + 1, 4)
        For i = 1 To (max_an - min_an + 1)
            For j = 1 To 4
                trimestre2D(i, j) = 0
            Next j
        Next i
        For k = 1 To ndim
            For j = 1 To 4
                If Val(trim(k)) = j Then
                    it = j
                End If
            Next j
            For i = min_an To max_an
                If Val(annee(k)) = i Then
                    ia = i - min_an + 1
                End If
            Next i
     
            trimestre2D(ia, it) = k
        Next k
     
       ReDim tmp(1 To UBound(tbl))
       ncount = 0
       For i = 1 To (max_an - min_an + 1)
            For j = 1 To 4
                If trimestre2D(i, j) <> 0 Then
                    ncount = ncount + 1
                    k = trimestre2D(i, j)
                    tmp(ncount) = "T" & trim(k) & "-" & annee(k)
                End If
            Next j
        Next i
     
     
     
       range_croissant = tmp
       End Function
     
    Function min_annee(tbl()) As Integer
        Dim imin As Integer
        Dim tmp1() As String
        Dim annee() As String
     
        ndim = UBound(tbl)
        ReDim annee(ndim)
        For i = 1 To ndim
            tmp1 = Split(tbl(i), "-")
            annee(i) = tmp1(1)
        Next i
     
        imin = annee(1)
     
        For i = 2 To UBound(annee)
            If Val(annee(i)) < imin Then
                imin = Val(annee(i))
            End If
        Next i
    min_annee = imin
     
    End Function
    Function max_annee(tbl()) As Integer
        Dim imax As Integer
        Dim tmp1() As String
        Dim annee() As String
     
        ndim = UBound(tbl)
        ReDim annee(ndim)
        For i = 1 To ndim
            tmp1 = Split(tbl(i), "-")
            annee(i) = tmp1(1)
        Next i
     
        imax = annee(1)
     
        For i = 2 To UBound(annee)
            If Val(annee(i)) > imax Then
                imax = Val(annee(i))
            End If
        Next i
    max_annee = imax
     
    End Function
     
     
     
    Function premiere_annee(tbl()) As Variant
        Dim tmp() As Variant
        Dim annee1 As Integer
        Dim tmp1() As String
        Dim ndim As Integer
     
     
        ndim = UBound(tbl)
     
        annee1 = min_annee(tbl)
     
        ReDim tmp(ndim)
        For i = 1 To ndim
            tmp(i) = "autre"
        Next i
     
        For i = 1 To ndim
         tmp1 = Split(tbl(i), "-")
         If Val(tmp1(1)) = annee1 Then
            tmp(i) = tbl(i)
         End If
        Next i
     
        tmp = sans_zero(tmp)
     
     
    premiere_annee = tmp
    End Function

  16. #16
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    Ca fait trois fois que tu me dis :

    Il y a un bug
    Précise plutôt la ligne qui pose problème et le message d'erreur.

  17. #17
    Membre confirmé
    Profil pro
    Inscrit en
    Février 2011
    Messages
    70
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 70
    Par défaut
    Dans la sous-routine supprimer doublons, (ligne 221)
    mais je pense que le problème est ailleurs, car jusqu'aux 2 premières graphes( répartition nbr. de mutant par année pour le premier graphe et répartition par direction sur la plus petite année) tout allait très bien, depuis que j'ai écrit l'algorithme du graphe pour la répartition par métier du service de mutation pour la plus petite année. Aucun graphe précédent ne s'affiche.

    Merci par avance

  18. #18
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    Oui, mais je ne me suis pas servi de ta routine pour les deux premiers graphiques. Je regarde.

  19. #19
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Septembre 2011
    Messages
    8 208
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Septembre 2011
    Messages : 8 208
    Par défaut
    Remplace la ligne 38 par :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
        PossMetier = listeMetier
    Vérifie que ça fait bien ce que tu veux.

  20. #20
    Membre confirmé
    Profil pro
    Inscrit en
    Février 2011
    Messages
    70
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2011
    Messages : 70
    Par défaut
    merci Daniel,
    ça m'aide beaucoup, sans toutefois résoudre tous mes problèmes. J'ai pu avancer comme une torture, j’espère que j'y arriverai un jour.
    Par contre, j'ai une question au niveau du graphique du camembert: il y a un décalage dans les légendes: disons que par exemple j'ai:
    A1 quantité 1
    A2 quantité 2
    A3 quantité 3:

    Si mon camembert ne retient que les catégories A1 et A3 il va prendre les bonnes quantités mais afficher les légendes A2 et rien du tout.

    J'ai trouvé la solution. Il y avait un problème de numérotation (tableau des données de 1 à N tableau des valeurs de 0 à N)

    Merci pour l'aide, j'inclus la macro finale ou cas cela peut aider quelqu'un



    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    229
    230
    231
    232
    233
    234
    235
    236
    237
    238
    239
    240
    241
    242
    243
    244
    245
    246
    247
    248
    249
    250
    251
    252
    253
    254
    255
    256
    257
    258
    259
    260
    261
    262
    263
    264
    265
    266
    267
    268
    269
    270
    271
    272
    273
    274
    275
    276
    277
    278
    279
    280
    281
    282
    283
    284
    285
    286
    287
    288
    289
    290
    291
    292
    293
    294
    295
    296
    297
    298
    299
    300
    301
    302
    303
    304
    305
    306
    307
    308
    309
    310
    311
    312
    313
    314
    315
    316
    317
    318
    319
    320
    321
    322
    323
    324
    325
    326
    327
    328
    329
    330
    331
    332
    333
    334
    335
    336
    337
    338
    339
    340
    341
    342
    343
    344
    345
    346
    347
    348
    349
    350
    351
    352
    353
    354
    355
    356
    357
    358
    359
    360
    361
    362
    363
    364
    365
    366
    367
    368
    369
    370
    371
    372
    373
    374
    375
    376
    377
    378
    379
    380
    381
    382
    383
    384
    385
    386
    387
    388
    389
    390
    391
    392
    393
    394
    395
    396
    397
    398
    399
    400
    401
    402
    403
    404
    405
    406
    407
    408
    409
    410
    411
    412
    413
    414
    415
    416
    417
    418
    419
    420
    421
    422
    423
    424
    425
    426
    427
    428
    429
    430
    431
    432
    Sub CreateChartPouet(feuille As String)
        Dim Plage As Range
        Dim PossDirection() As Variant, PossPeriode() As Variant, PossMetier() As Variant
        Dim SPossPeriode() As Variant
        Dim listeDirection() As Variant, listeMetier() As Variant
        Dim i As Integer, j As Integer, nl As Integer, nligne As Integer
        Dim myrange As String, mysheetname As String
        Dim shtoto As Worksheet
        Dim tmp() As Variant
        Dim d As Double
        Dim c As Range
        Dim test() As String
        Dim tableau2() As Double
     
     
     
        For Each sh In Sheets
           If Left(sh.Name, 5) = "Graph" Then sh.Delete
       Next sh
        Application.DisplayAlerts = True
     
        Worksheets(feuille).Activate
     
     
     
        'récupération des directions de mutation
     
        Set Plage = Range("C2:C" & Range("C65536").End(xlUp).Row)
        PossDirection = Application.Transpose(Plage.Value)
        listeDirection = PossDirection
        PossDirection = SupprimerDoublons(PossDirection)
     
     
     
        ' récupération des listes métiers
        Set Plage = Range("D2:D" & Range("D65536").End(xlUp).Row)
        PossMetier = Application.Transpose(Plage.Value)
        listeMetier = PossMetier
        PossMetier = SupprimerDoublons(PossMetier)
     
     
        ' récupération des trimestres et années de mutation
        Set Plage = Range("B2:B" & Range("B65536").End(xlUp).Row)
        PossPeriode = Application.Transpose(Plage.Value)
        listePeriode = PossPeriode
        PossPeriode = SupprimerDoublons(PossPeriode)
        SPossPeriode = range_croissant(PossPeriode)
        For i = 1 To UBound(PossPeriode)
            PossPeriode(i) = SPossPeriode(i)
        Next i
        ' Graph Bâton
        Charts.Add
        Dim tableau() As Long
        ReDim tableau(1 To UBound(PossPeriode))
        For i = 1 To UBound(PossPeriode)
            tableau(i) = Application.CountIf(Plage, PossPeriode(i))
        Next i
        With ActiveChart
           ' .SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = PossPeriode  'Abscisses
            .SeriesCollection(1).Values = tableau 'Ordonnées
            .ChartType = xlColumnClustered   'type de graph
        End With
     
     
     
        possannee1 = premiere_annee(PossPeriode)
     
        ncount = 0
        For i = 1 To UBound(listePeriode)
            For j = 1 To UBound(possannee1)
                If listePeriode(i) = possannee1(j) Then
                    ncount = ncount + 1
                End If
            Next j
        Next i
     
     
        ReDim dirannee1(1 To ncount)
        ncount = 0
        For i = 1 To UBound(listePeriode)
            For j = 1 To UBound(possannee1)
                If listePeriode(i) = possannee1(j) Then
                    ncount = ncount + 1
                    dirannee1(ncount) = listeDirection(i)
                End If
            Next j
     
        Next i
     
       ReDim tableau2(1 To UBound(PossDirection))
       For i = 1 To UBound(dirannee1)
        For j = 1 To UBound(PossDirection)
            If dirannee1(i) = PossDirection(j) Then
     
                tableau2(j) = tableau2(j) + 1
            End If
        Next j
        Next i
     
        For i = 1 To UBound(tableau2)
            MsgBox PossDirection(i)
            MsgBox tableau2(i)
        Next i
     
        Charts.Add
        With ActiveChart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = PossDirection  'Abscisses
            .SeriesCollection(1).Values = tableau2 'Ordonnées
            .ChartType = xlPie
            .HasLegend = False
            .SeriesCollection(1).ApplyDataLabels AutoText:=True, LegendKey:= _
                False, HasLeaderLines:=True, ShowSeriesName:=False, ShowCategoryName:= _
                True, ShowValue:=True, ShowPercentage:=False, ShowBubbleSize:=False, Separator _
            :="" & Chr(10) & ""
            With .SeriesCollection(1).DataLabels
               .HorizontalAlignment = xlCenter
               .VerticalAlignment = xlCenter
               .ReadingOrder = xlContext
               .Position = xlLabelPositionCenter
               .Orientation = xlHorizontal
            End With
           With .SeriesCollection(1)
              p = .Values
              For i = 1 To .Points.Count
                  If p(i) = 0 Then .Points(i).DataLabel.Delete
              Next
            End With
        End With
     
     
        MsgBox "fin du camembert"
     
     
        'camembert de la DCT
        ' récupération des métiers de la DCT
        ncount = 0
        For i = 1 To UBound(listeDirection)
            If listeDirection(i) = "DCT" Then
                For j = 1 To UBound(possannee1)
                    If listePeriode(i) = possannee1(j) Then
                        ncount = ncount + 1
                    End If
                Next j
            End If
     
        Next i
     
     
        ReDim tbl(1 To ncount)
        ncount = 0
         For i = 1 To UBound(listeDirection)
            If listeDirection(i) = "DCT" Then
                For j = 1 To UBound(possannee1)
                    If listePeriode(i) = possannee1(j) Then
                        ncount = ncount + 1
                        tbl(ncount) = listeMetier(i)
                    End If
                Next j
            End If
        Next i
        sous_tableDCT = tbl
        tbl = SupprimerDoublons(tbl)
     
     
      ' créer le tableau 2
     
        ReDim tableau2(1 To UBound(tbl))
        For i = 1 To UBound(sous_tableDCT)
            For j = 1 To UBound(tbl)
                If sous_tableDCT(i) = tbl(j) Then
                    tableau2(j) = tableau2(j) + 1
                End If
            Next j
        Next i
     
     
     
       Charts.Add
        With ActiveChart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = tbl  'Abscisses
          .SeriesCollection(1).Values = tableau2 'Ordonnées
            .ChartType = xlPie
            .SeriesCollection(1).ApplyDataLabels AutoText:=True, LegendKey:= _
                False, HasLeaderLines:=True, ShowSeriesName:=False, ShowCategoryName:= _
                True, ShowValue:=True, ShowPercentage:=False, ShowBubbleSize:=False, Separator _
            :="" & Chr(10) & ""
            .HasLegend = False
            With .SeriesCollection(1).DataLabels
               .HorizontalAlignment = xlCenter
               .VerticalAlignment = xlCenter
               .ReadingOrder = xlContext
               .Position = xlLabelPositionCenter
               .Orientation = xlHorizontal
            End With
           With .SeriesCollection(1)
              p = .Values
              For i = 1 To .Points.Count
                  If p(i) = 0 Then .Points(i).DataLabel.Delete
              Next
            End With
       End With
     '   [M:O].ClearContents
     
     End Sub
     
     
     
     
    Function SupprimerDoublons(tbl()) As Variant()
     
        Dim Dico As Object
        Dim Cle
        Dim T()
        Dim i As Long
     
        'crée l'objet
     
        Set Dico = CreateObject("Scripting.Dictionary")
     
        'inscrit les valeurs dans le dictionnaire
        'en affectant aussi cette valeur à la clé
        'une clé devant être unique, si on ne contrôle pas
        'son existance dans la collection, un erreur est générée
        For i = 1 To UBound(tbl)
            If Dico.Exists(tbl(i)) = False Then
                Dico.Add tbl(i), tbl(i)
            End If
        Next i
     
        i = 0
     
        'tranfert des valeurs uniques dans un tableau
        For Each Cle In Dico.keys
            i = i + 1
            ReDim Preserve T(1 To i)
            T(i) = Cle
        Next
     
     
     
     
        'passage de ce tableau à la fonction
        SupprimerDoublons = T
     
        'libère la mémoire
        Set Dico = Nothing
     
    End Function
     
     
     Function WsExist(nomFeuil As String) As Boolean
    On Error Resume Next
    WsExist = Sheets(nomFeuil).Index
       End Function
     
     
     
     
    Function sans_zero(tbl()) As Variant()
        Dim ih As Integer
        Dim nn As Integer
        Dim i As Integer
        Dim T()
     
     
     
            ih = 0
            For i = 1 To UBound(tbl)
                If tbl(i) <> 0 Or tbl(i) <> " " Or tbl(i) <> "0" Then
                    ih = ih + 1
                End If
            Next i
        ReDim T(ih)
            nn = 0
            For i = 1 To UBound(tbl)
                If tbl(i) <> 0 Or tbl(i) <> " " Or tbl(i) <> "0" Then
                    nn = nn + 1
                    T(nn) = tbl(i)
                End If
            Next i
     
        sans_zero = T
     
     
    End Function
     
     
     Function range_croissant(tbl()) As Variant()
        Dim tmp() As Variant
        Dim tmp1() As String
        Dim tmp2() As String
     
        Dim trim() As String
        Dim annee() As String
        Dim min_an As Integer
        Dim max_an As Integer
        Dim annees() As String
        Dim ndim As Integer
        Dim trimestre2D() As Integer
     
     
        ndim = UBound(tbl)
     
     
        ReDim trim(ndim)
        ReDim annee(ndim)
        For i = 1 To ndim
            tmp1 = Split(tbl(i), "-")
            tmp2 = Split(tmp1(0), "T")
            trim(i) = tmp2(1)
            annee(i) = tmp1(1)
        Next i
     
        min_an = min_annee(tbl)
        max_an = max_annee(tbl)
     
        ReDim trimestre2D(max_an - min_an + 1, 4)
        For i = 1 To (max_an - min_an + 1)
            For j = 1 To 4
                trimestre2D(i, j) = 0
            Next j
        Next i
        For k = 1 To ndim
            For j = 1 To 4
                If Val(trim(k)) = j Then
                    it = j
                End If
            Next j
            For i = min_an To max_an
                If Val(annee(k)) = i Then
                    ia = i - min_an + 1
                End If
            Next i
     
            trimestre2D(ia, it) = k
        Next k
     
       ReDim tmp(1 To UBound(tbl))
       ncount = 0
       For i = 1 To (max_an - min_an + 1)
            For j = 1 To 4
                If trimestre2D(i, j) <> 0 Then
                    ncount = ncount + 1
                    k = trimestre2D(i, j)
                    tmp(ncount) = "T" & trim(k) & "-" & annee(k)
                End If
            Next j
        Next i
     
     
     
       range_croissant = tmp
       End Function
     
    Function min_annee(tbl()) As Integer
        Dim imin As Integer
        Dim tmp1() As String
        Dim annee() As String
     
        ndim = UBound(tbl)
        ReDim annee(ndim)
        For i = 1 To ndim
            tmp1 = Split(tbl(i), "-")
            annee(i) = tmp1(1)
        Next i
     
        imin = annee(1)
     
        For i = 2 To UBound(annee)
            If Val(annee(i)) < imin Then
                imin = Val(annee(i))
            End If
        Next i
    min_annee = imin
     
    End Function
    Function max_annee(tbl()) As Integer
        Dim imax As Integer
        Dim tmp1() As String
        Dim annee() As String
     
        ndim = UBound(tbl)
        ReDim annee(ndim)
        For i = 1 To ndim
            tmp1 = Split(tbl(i), "-")
            annee(i) = tmp1(1)
        Next i
     
        imax = annee(1)
     
        For i = 2 To UBound(annee)
            If Val(annee(i)) > imax Then
                imax = Val(annee(i))
            End If
        Next i
    max_annee = imax
     
    End Function
     
     
     
    Function premiere_annee(tbl()) As Variant
        Dim tmp() As Variant
        Dim annee1 As Integer
        Dim tmp1() As String
        Dim ndim As Integer
     
     
        ndim = UBound(tbl)
     
        annee1 = min_annee(tbl)
     
        ReDim tmp(ndim)
        For i = 1 To ndim
            tmp(i) = "autre"
        Next i
     
        For i = 1 To ndim
         tmp1 = Split(tbl(i), "-")
         If Val(tmp1(1)) = annee1 Then
            tmp(i) = tbl(i)
         End If
        Next i
     
        tmp = sans_zero(tmp)
     
     
    premiere_annee = tmp
    End Function

+ Répondre à la discussion
Cette discussion est résolue.
Page 1 sur 2 12 DernièreDernière

Discussions similaires

  1. comment programmer un afficheur graphique?
    Par eric47 dans le forum C
    Réponses: 17
    Dernier message: 02/02/2008, 12h40
  2. Comment programmer un défilement fluide en mode graphique ?
    Par 'ti programmeur dans le forum Pascal
    Réponses: 10
    Dernier message: 14/01/2007, 17h54
  3. Réponses: 7
    Dernier message: 13/12/2004, 19h23
  4. [RAVE][DELPHI7] Comment faire un graphique ?
    Par DFANDOR dans le forum Rave
    Réponses: 7
    Dernier message: 06/02/2003, 20h25
  5. comment programmer une progressbar
    Par Choucas dans le forum Paradox
    Réponses: 3
    Dernier message: 13/11/2002, 11h07

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo