problème pour compter le nombre de cellules non vides

babalouche

XLDnaute Nouveau
Bonjour le forum,
j'ai deux fichiers excel l'un contenant la macro et l'autre un tableau variable où je souhaiterais faire des graphiques avec. Pour cette partie on m'a déjà aidé pour les problèmes que j'ai eu sauf que j'aimerais mettre des conditions sur les graphiques (type de graphe principalement). Le type de graphe se ferait selon le nombre de données dans une même colonne mais je n'arrive pas à avoir cette valeur là.
En gras c'est ma boucle pour savoir le nombre de données par colonne.
voici mon code :

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, ligne As Double, cels As Double, c As Double
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
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)
Wbk.Worksheets(1).Activate
ligne = Application.WorksheetFunction.CountA(Columns(1))
For Col = 1 To RngTit.Columns.Count
If Col <> ColDate Then
Set Cht = Wbk.Charts.Add
Set Sér = Cht.SeriesCollection.NewSeries
Sér.Name = RngTit.Columns(Col)
Sér.XValues = RngDon.Columns(ColDate)
Sér.Values = RngDon.Columns(Col)
cels = O
For c = 2 To ligne
If Cells(c, Col) <> "" Then
cels = cels + 1
End If
Next c

If cels > 10 Then
Cht.ChartType = xlLine
End If
If cels > 6 Then
Cht.ChartType = xlPie
End If
End If
Next Col
End Sub
 

babalouche

XLDnaute Nouveau
La boucle do while se place où par rapport à la modification du set sér
VB:
   For Col = 1 To RngTit.Columns.Count
        If Col <> ColDate Then
            Set Cht = Wbk.Charts.Add
            Do While Cht.SeriesCollection.Count > 1: Cht.SeriesCollection(1).Delete: Loop
            Set Sér = Cht.SeriesCollection(1)
            Sér.Name = RngTit.Columns(Col)
            Sér.XValues = RngDon.Columns(ColDate)
            Sér.Values = RngDon.Columns(Col)
            Select Case WorksheetFunction.CountA(RngDon.Columns(Col))
                Case Is > 10: Cht.ChartType = xlLine
                Case Is > 6: Cht.ChartType = xlPie
                Case Else: Cht.ChartType = xlColumnClustered
            End Select
        End If
    Next Col
End Sub
Pour la ligne du set sér = ... j'obtiens une erreur 1004
 

Dranreb

XLDnaute Barbatruc
Oui, il faut un test devant: If Cht.SeriesCollection.Count > 0 Then Set Sér = ChtSeriesCollection(1) Else Set Sér = Cht.SeriesCollection.NewSeries
Ça commence à faire beaucoup de Cht.SeriesCollection, alors peut être que ce serait plus lisible de mettre chaque fois juste un point et d'encadrer tout ça de: With Cht.SeriesCollection … End With. Pour désigner la 1ère série existante .Item(1) devrait marcher.
À votre place je crois que je remplacerais Sér.Name = RngTit.Columns(Col) par Chart.Name = RngTit.Columns(Col): Sér.Name = ""
Et même: On Error Resume Next: Set Cht = Wbk.Charts(RngTit.Columns(Col)): If Err Then Set Cht = Wbk.Charts.Add: Chart.Name = RngTit.Columns(Col)
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
C'est une erreur de ma part je voulais dire Cht.Name
Vous pouvez mettre toutes les instructions sur une même ligne séparées de ': ' pour avoir une procédure globalement concise ou mettre une seule instruction par ligne, comme vous voulez.
 

babalouche

XLDnaute Nouveau
D'accord merci voilà mon code j'ai une erreur de compilation end with sans with
VB:
    For Col = 1 To RngTit.Columns.Count
        If Col <> ColDate Then
            Set Cht = Wbk.Charts.Add
            With Cht.SeriesCollection
                If .Count > 0 Then
                    Set Sér = .Item(1)
                Else: Set Sér = .NewSeries
            End With
                Cht.Name = RngTit.Columns(Col): Sér.Name = RngTit.Columns(Col)
                Sér.XValues = RngDon.Columns(ColDate)
                Sér.Values = RngDon.Columns(Col)
            Select Case WorksheetFunction.CountA(RngDon.Columns(Col))
                Case Is > 10: Cht.ChartType = xlLine
                Case Is > 6: Cht.ChartType = xlPie
                Case Else: Cht.ChartType = xlColumnClustered
            End Select
        End If
    Next Col
End Sub
 

Dranreb

XLDnaute Barbatruc
Avec cette syntaxe, manque un End If. C'est pourquoi, si les instruction sont courtes et peu nombreuses, je préfère le If simplifié avec tout sur la même ligne.
J'ai finalement fait autrement juste pour ça, en utilisant le On Error Resume Next vu qu'il y était de toute façon déjà. J'en suis là, à tester :
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
    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
        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
            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
            Sér.Name = ""
            Sér.XValues = RngDon.Columns(ColDate)
            Sér.Values = RngDon.Columns(Col)
            Select Case WorksheetFunction.CountA(RngDon.Columns(Col))
                Case Is > 10: Cht.ChartType = xlLine
                Case Is > 6: Cht.ChartType = xlPie
                Case Else: Cht.ChartType = xlColumnClustered
            End Select
        End If
    Next Col
End Sub
 

Dranreb

XLDnaute Barbatruc
Oui, Err est un objet VBA à plusieurs propriétés dont Number et Description, positionné selon les erreurs rencontrées. Number est la propriété par défaut, assumée si on ne la précise pas, et un If avec en tant que condition juste un nombre considère celle ci vraie si ce nombre est différent de 0.
Normalement seul l'onglet du graphique doit avoir le titre pour nom. Mais si ça a une conséquence gênante vous pouvez quand même l'affecter aussi à Sér.Name
 

babalouche

XLDnaute Nouveau
Merci pour le if Err et le titre de la feuille du graphique c'est que pour les 2 cas avec ' client A' dans le tableau qui fait que le titre de la feuille n'a pas le nom ...'client A' mais graphique6 ou graphique4 par exemple mais c'est bon pour contrer ça j'ai mis un titre aux graphiques.
Merci de votre aide j'en ai finit avec ça.
 

Dranreb

XLDnaute Barbatruc
Mettez: Titre = Replace(RngTit.Columns(Col).Value, "'", "")
L'appostrophe est utilisée par Excel comme délimiteur du nom de feuille dans les adresses de cellules des formules quand il comporte des caractères qui gêneraient leur interprétation, des espaces notamment. Peut être qu'en les doublant, au contraire, ça passerait aussi…
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 886
Membres
101 830
dernier inscrit
sonia poulaert