utilisation de tableaux pour faire un graphique

Question

Bonjour le forum, J'ai un dictionnaire et je veux faire un graphique des valeurs en fonction des clefs donc je les stocke dans 2 tableaux l'un pour les clefs l'autre les valeurs et que mon code ne marche pas je n'obtiens pas de graphique. Voici le code en question Option Explicit Sub Workbook_Open() Dim Wbk As Workbook, Cht As Chart, RngTit As Range, RngDon As Range, _ ColDate As Long, Col As Long, Sér As Series, Titre As String, ligne As Long, dat As Date, lig As Long Dim mot As String, lign As Long, d, t, i&, repetitions() As Variant, clefs() As Variant, compteur As Long, element, nbrele Public graph As Integer For Each Wbk In Application.Workbooks If Wbk.Name <> ThisWorkbook.Name Then Exit For Next Wbk Set RngDon = Wbk.Worksheets(1).UsedRange For ColDate = 1 To RngDon.Columns.Count + 2 If IsDate(RngDon(2, ColDate).Value) Then Exit For Next ColDate If ColDate > RngDon.Columns.Count Then ColDate = 1 End If Set RngTit = RngDon.Rows(1) Set RngDon = RngDon.Rows(2).Resize(RngDon.Rows.Count - 1) For Col = 1 To RngTit.Columns.Count If Col <> ColDate Then If VarType(RngDon.Cells(1, Col).Value) = 8 Then Set d = CreateObject("Scripting.Dictionary") For lign = 1 To RngDon.Rows.Count mot = RngDon.Cells(lign, Col) If Not d.exists(mot) Then d.Add mot, 1 compteur = compteur + 1 Else d(mot) = d(mot) + 1 End If Next lign i = 1 ReDim clef(compteur) For Each element In d.Keys clefs(i) = element i = i + 1 Next element i = 1 ReDim repetitions(compteur) For Each nbrele In d.items repetitions(i) = nbrele i = i + 1 Next nbrele Titre = RngTit.Columns(Col) On Error Resume Next Set Cht = Wbk.Charts(Titre) If Err Then Set Cht = Wbk.Charts.Add: Cht.Name = Titre With Cht.SeriesCollection Do While .Count > 1: .Item(1).Delete: Loop Err.Clear: Set Sér = .Item(1): If Err Then Set Sér = .NewSeries End With On Error GoTo 0 If UBound(t) = 1 Then Exit For Sér.XValues = repetitions Sér.Values = clefs Sér.Name = RngTit.Columns(Col) Cht.ChartType = xlPie Cht.ChartStyle = 259 d.RemoveAll Erase repetitions, clefs end if end if end sub

Patrice33740 · Answer

Bonjour,

Évites de mettre un code spécifique dans Workbook_Open
Il est préférable de placer le code dans un module standard et de l'appeler depuis  Workbook_Open

Essaies ce code :
' Note : il faut activer les références (dans Outils > Références ...) à :
' - Microsoft Scripting Runtime
Option Explicit
Sub test()
Dim d As Dictionary     'Dictionnaire des dates et nombre pour chaque date
Dim w As Workbook       'Classeur
Dim x As Variant        'Tableau des valeurs de l'axe horizontal (dates)
Dim v As Variant        'Tableau des valeurs de l'axe vertical (nombre)
Dim r As Range          'Plage des données
Dim c As Range          'Cellule analysée
Dim k As Range          'Colonne des données
Dim g As Chart          'Graphique
Dim s As Series         'Série de donnéesdu graphique
Dim n As String         'Nom de la colonne
 
  For Each w In Application.Workbooks
    If w.Name <> ThisWorkbook.Name Then Exit For
  Next w
  Set r = w.Worksheets(1).UsedRange
  Set r = r.Offset(1).Resize(r.Rows.Count - 1)
  For Each c In r.Rows(1).Cells
    If IsDate(c.Value) Then
      Set k = Intersect(r, c.EntireColumn)
      n = c.Offset(-1).Value
      Exit For
    End If
  Next c
  If Not k Is Nothing Then
    Set d = New Dictionary
    For Each c In k.Cells
      If Not d.exists(c.Text) Then
        d.Add c.Text, 1
      Else
        d(c.Text) = d(c.Text) + 1
      End If
    Next c
  End If
  If Not d Is Nothing Then
    v = d.Items
    x = d.Keys
    d.RemoveAll
    Set d = Nothing
    On Error Resume Next
    Set g = w.Charts(n)
    On Error GoTo 0
    If Not g Is Nothing Then
      For Each s In g.SeriesCollection
        s.Delete
      Next s
    Else
      Set g = w.Charts.Add2
      g.Name = n
    End If
    g.ChartType = xlColumnClustered  'ou autre
    g.SeriesCollection.NewSeries
    g.FullSeriesCollection(1).Name = n
    g.FullSeriesCollection(1).Values = v
    g.FullSeriesCollection(1).XValues = x
    g.ChartTitle.Text = n
  End If
End Sub

Utilisation de tableaux pour faire un graphique

1 réponse

Discussions similaires

Newsletters