XL 2013 Mise à jour VBA

[Lericounet06]

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]

Bonjour,


A mon avis y a comme un soucy, voire deux.

non il n'y a pas de soucis j'ai travaillé sans fichier donc les noms de feuilles sont tels q' a l'origine de leur création

 

[patricktoulon]

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]

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

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

 

[Lericounet06]

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]

et bien la chose est simple

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

 

[Lericounet06]

Et bien Patrick je te dis un grand merci car tu as résolu mon problème et çà va me faire gagner beaucoup de temps dans mon travail.

Passe une très belle journée et un bon week-end

A+

Eric

 

[TooFatBoy]

non il n'y a pas de soucis

Si tu ne vois pas de soucis, alors il faut que tu prennes rapidement rendez-vous chez un ophtalmo...

 

[patricktoulon]

de rien à +

 

[patricktoulon]

re
mille excuses à @TooFatBoy il avait raison , j'avais laissé trainer un guillemet dans mon post #11

 

[TooFatBoy]

re
mille excuses à @TooFatBoy il avait raison , j'avais laissé trainer un guillemet dans mon post #11

Pas de problème, camarade.

Oui, un guillemet et un caractère égal en trop juste avant le THEN, mais c'était déjà corrigé en #18.