Utilisation de tableaux pour faire un graphique

batou26 Messages postés 1 Date d'inscription Statut Membre Dernière intervention -
Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention - 4 août 2018 à 17:13

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

Afficher la suite

A voir également:

Utilisation de tableaux pour faire un graphique
Utilisation chromecast - Guide
Télécharger gratuitement notice d'utilisation - Guide
Changer de carte graphique - Guide
Comment faire un graphique sur excel - Guide
Comment faire un tableau - Guide

1 réponse

Réponse 1 / 1

Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention 1 780

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

Discussions similaires

Impossible d'utiliser ce numéro de téléphone pour la validat

CALCULS

Votre réponse

Discussions similaires