XL 2013 Utilisation de tableaux pour faire un graphique

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
235
Réponses
4
Affichages
177
Réponses
5
Affichages
232
Réponses
10
Affichages
281
Réponses
5
Affichages
182
Retour