XL 2013 Utilisation de tableaux pour faire un graphique

babalouche

XLDnaute Nouveau
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
VB:
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
 

Discussions similaires

Réponses
4
Affichages
418

Statistiques des forums

Discussions
314 638
Messages
2 111 475
Membres
111 161
dernier inscrit
KARIMTAPSO