Problème automatisation macro

Salut a tous,

Je travail sur un fichier de suivi/réception de documents que j'essaye d'automatiser; avec deux macros :

1)Compter automatiquement le nombre de couleurs

On a un code de couleur simple qui permet de comptabiliser les documents reçu et non reçu, la macro permet de calculer automatiquement le nombre de case rouge (non reçu) et le nombre de case verte (reçu)

2) Masquer automatiquement certains onglets

Je dois envoyer se fichier à différents groupes, l'objectif est de pouvoir sélectionner l'onglet qui les concerne et de masquer les autres.

Mon problème : Depuis que j'ai installé la seconde macro, j'ai un problème sur la première et lors des calculs de mes cases de couleurs, j'obtiens #VALEUR!, je suis obligé de cliquer sur la formule et de d'appuyer sur entré pour la remettre moi même à jour. Cela ne se fait plus automatiquement.

Auriez-vous une solution pour éviter ce problème ?

Merci d'avance

Bonjour,

J'ai cherché longtemps pour trouver ce qui pose problème.

Il semble que ce soit ...

1- Modul1

Function CouleurCellule(Plage As Range, Cel As Range) As Long

J'ai mis en commentaire 'Application.Volatile

Du coup, on gagne aussi en rapidité.

Ce qui n'était pas dans la fonction soumise par Theze ... qu'il faut saluer au passage.

ric

Bonjour, Bonjour ric !

Et oui, Application.Volatile est très bien sur quelques formules mais vu le nombre, c'est sûr, ça rame !

Il faut savoir que rendre une fonction volatile fait en sorte qu'au moindre calcul dans la feuille, édition de n'importe quelle cellule, la fonction est appelée même si aucune cellules n'y fait référence , comme les fonctions Alea(), Aujourdhui(), Maintenant(), etc...

Vu le grand nombre de cellules à contrôler dans les plages de cet assez grand nombre de feuilles, il faudrait peut être passer sur une autre façon de gérer ces couleurs, une procédure événementielle niveau classeur en ne visant que la feuille concernée mais là non plus je ne suis pas convaincu de l'efficacité !

Une piste pas beaucoup plus valide que la fonction mais à tester !

Le code à mettre dans un module de classe nommé Classe1 (nom par défaut à l'ajout du premier) :

Dim LaPlage As Range
Dim LaCelRouge As Range
Dim LaCelVerte As Range
Dim LaCelJaune As Range

Property Set Plage(Zone As Range)

    Set LaPlage = Zone

End Property

Property Set CelRouge(Cel As Range)

    Set LaCelRouge = Cel

End Property

Property Set CelVerte(Cel As Range)

    Set LaCelVerte = Cel

End Property

Property Set CelJaune(Cel As Range)

    Set LaCelJaune = Cel

End Property

Property Get NBRouge() As Long

    NBRouge = Couleur(LaPlage, LaCelRouge)

End Property

Property Get NBVerte() As Long

    NBVerte = Couleur(LaPlage, LaCelVerte)

End Property

Property Get NBJaune() As Long

    NBJaune = Couleur(LaPlage, LaCelJaune)

End Property

Private Function Couleur(Plage As Range, Cel As Range)

    Dim Dico As Object
    Dim C As Range

    Set Dico = CreateObject("Scripting.Dictionary")

    For Each C In Plage

        If C.Interior.Color = Cel.Interior.Color Then Dico(C.MergeArea.Address) = C.MergeArea.Address

    Next C

    Couleur = Dico.Count

End Function

Code à mettre dans le module du classeur :

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)

    Dim Cls As New Classe1

    Set Cls.Plage = sh.Range("S10:AD200")
    Set Cls.CelVerte = sh.Range("AG1")
    Set Cls.CelRouge = sh.Range("AG2")
    Set Cls.CelJaune = sh.Range("AG3")

    Range("AH1") = Cls.NBVerte
    Range("AH2") = Cls.NBRouge
    Range("AH3") = Cls.NBJaune

End Sub

Comme les plages sont sur les colonnes S à AD, passer la plage "S10:AD200" tester et adapter. Il te faut supprimer toutes les procédures événementielles "Worksheet_SelectionChange()" des feuilles qui appelles le calcul