XL 2013 Mise à jour VBA

Lericounet06

XLDnaute Junior
Bonjour,

j'ai fait une VBA pour compter le nombre de cellules en couleur mais à chaque fois que j'enlève ou que je rajoute (manuellement) de la couleur, mon résultat ne se met pas à jour.

Pour faire ma mise à jour, je suis obligé d'aller dans ma cellule de résultat (=CompterCouleur('Feuill'!H7:H300;'Feuill'!C1)) et faire "enter"

Ma VBA :

Function CompterCouleur(PlageCouleur As Range, Couleur As Range)

Dim CodeCouleur As Integer
Dim NbrCouleur As Integer

CodeCouleur = Couleur.Interior.ColorIndex
Set CCell = PlageCouleur
For Each CCell In PlageCouleur
If CCell.Interior.ColorIndex = CodeCouleur Then
NbrCouleur = NbrCouleur + 1
End If
Next CCell
CompterCouleur = NbrCouleur


End Function


Pouvez-vous m'aider ?

Merci d'avance

Eric
 

patricktoulon

XLDnaute Barbatruc
bon on a donc 3 feuille L1 , L2 , L3
la plage de comptage est toujours H7:H300 me semble t il pour les 3 feuilles
la cellule pour la couleur recherchée est la I3 pour les 3 feuilles
quelle est la ca cellule de destination dans les tableaux de la feuille "Lignes et arrêts"
pour
L1
L2
L3
réponds a cette question et je te fait ca
 

patricktoulon

XLDnaute Barbatruc
bon pour le coup je te l'ai fait pour la colonne H des 3 feuilles
j'ai ajouté le displayformat aussi au cas ou se serait la couleur d'une MFC
VB:
Private WithEvents CMB As CommandBars

Private Sub Cmb_OnUpdate()
'ActiveSheet.Calculate 'si tu veux garder ta formule
'sinon tu fait simplement

'pour la colonne H de la feuille L1
    [    'Lignes et arrêts'!B11] = CompterCouleur(Feuil2.[H7:H300], Feuil2.[I1])

'pour la colonne H de la feuille L2
    [    'Lignes et arrêts'!B20] = CompterCouleur(Feuil3.[H7:H300], Feuil3.[I3])

'pour la colonne H de la feuille L3
    [    'Lignes et arrêts'!I11] = CompterCouleur(Feuil4.[H7:H300], Feuil4.[I3])

End Sub

Private Sub Workbook_Open()
    Set CMB = Application.CommandBars

End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If " L1 L2 L3 " Like "* " & Sh.Name & " *" Then
        Set CMB = Application.CommandBars
    Else
        Set CMB = Nothing
    End If

End Sub

Function CompterCouleur(PlageCouleur As Range, Couleur As Range)
    Application.Volatile
    Dim CodeCouleur As Integer
    Dim NbrCouleur As Integer

    CodeCouleur = Couleur.Interior.ColorIndex
    CodeCouleur = Couleur.DisplayFormat.Interior.ColorIndex
    Set CCell = PlageCouleur
    For Each CCell In PlageCouleur
        If CCell.Interior.ColorIndex = CodeCouleur Or _
           CCell = Couleur.DisplayFormat.Interior.ColorIndex = CodeCouleur Then
            NbrCouleur = NbrCouleur + 1
        End If
    Next CCell
    CompterCouleur = NbrCouleur
End Function
demo.gif
 

Lericounet06

XLDnaute Junior
bon on a donc 3 feuille L1 , L2 , L3
la plage de comptage est toujours H7:H300 me semble t il pour les 3 feuilles
la cellule pour la couleur recherchée est la I3 pour les 3 feuilles
quelle est la ca cellule de destination dans les tableaux de la feuille "Lignes et arrêts"
pour
L1
L2
L3
réponds a cette question et je te fait ca
Salut Patrick,

pour la feuille L1 :
H7:H300 dans (Lignes et arrêts-B11)
T7:T300 dans (Lignes et arrêts-B13)

pour la feuille L2 :
H7:H300 dans (Lignes et arrêts-I11)
T7:T300 dans (Lignes et arrêts-I13)
AF7:AF300 dans (Lignes et arrêts-I15)

pour la feuille L3 :
H7:H300 dans (Lignes et arrêts-B20)
T7:T300 dans (Lignes et arrêts-B22)
 

patricktoulon

XLDnaute Barbatruc
et bien la chose est simple
VB:
Private WithEvents CMB As CommandBars

Private Sub Cmb_OnUpdate()
'ActiveSheet.Calculate 'si tu veux garder ta formule
'sinon tu fait simplement

'pour la colonne H de la feuille L1
    [    'Lignes et arrêts'!B11] = CompterCouleur(Feuil2.[H7:H300], Feuil2.[I1])
    [    'Lignes et arrêts'!B13] = CompterCouleur(Feuil2.[T7:T300], Feuil2.[I1])

'pour la colonne H de la feuille L2
    [    'Lignes et arrêts'!I11] = CompterCouleur(Feuil3.[H7:H300], Feuil3.[I1])
    [    'Lignes et arrêts'!I13] = CompterCouleur(Feuil3.[T7:T300], Feuil3.[I1])
    [    'Lignes et arrêts'!I15] = CompterCouleur(Feuil3.[AF7:AF300], Feuil3.[I1])

'pour la colonne H de la feuille L3
    [    'Lignes et arrêts'!B20] = CompterCouleur(Feuil4.[H7:H300], Feuil4.[I1])
    [    'Lignes et arrêts'!B22] = CompterCouleur(Feuil4.[T7:T300], Feuil4.[I1])

End Sub

Private Sub Workbook_Open()
    Set CMB = Application.CommandBars

End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If " L1 L2 L3 " Like "* " & Sh.Name & " *" Then
        Set CMB = Application.CommandBars
    Else
        Set CMB = Nothing
    End If

End Sub

Function CompterCouleur(PlageCouleur As Range, Couleur As Range)
    Application.Volatile
    Dim CodeCouleur As Integer
    Dim NbrCouleur As Integer

    CodeCouleur = Couleur.Interior.ColorIndex
    CodeCouleur = Couleur.DisplayFormat.Interior.ColorIndex
    Set CCell = PlageCouleur
    For Each CCell In PlageCouleur
        If CCell.Interior.ColorIndex = CodeCouleur Or _
           CCell = Couleur.DisplayFormat.Interior.ColorIndex = CodeCouleur Then
            NbrCouleur = NbrCouleur + 1
        End If
    Next CCell
    CompterCouleur = NbrCouleur
End Function
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
313 283
Messages
2 096 813
Membres
106 752
dernier inscrit
Tahiri1976