Discussion :

[Dautomne]

Bonjour A tous,

La macro Ecxel suivante bugue

l'outil de débogage surligne cette partie du code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

, colors As Scripting.Dictionary

Code complet :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub TEST()
Dim rg As Range, cl As Range, colors As Scripting.Dictionary, col As Long, maxnb As Long, colmax As Long, koul
Set rg = Range("c5:l5")
Set colors = New Scripting.Dictionary
For Each cl In rg
    col = cl.Interior.Color
    Select Case col
        Case vbWhite, 8421504:
        Case Else:
            If colors.Exists(col) Then
                colors(col) = colors(col) + 1
            Else
                Call colors.Add(col, 1)
            End If
 
    End Select
Next cl
colmax = 0
maxnb = 0
For Each koul In colors.keys
    If colors(koul) > maxnb Then
        maxnb = colors(koul)
        colmax = koul
    End If
Next koul
Sheets("Synthèse résultats ctrl période").Range("M5").Interior.Color = colmax
End Sub

N'ayant aucune notion de VBA quelqu'un peut-il corriger ce code :-)

L'objectif de la macro est de remplir la cellule M5 de la couleur la plus présente dans les cellules C5:L5.

Exemple :

Exemple : si la cellule C est remplie en vert, la cellule D est remplie en vert, la cellule E est remplie en vert, la cellule F est remplie en vert, la cellule G est remplie en jaune, la cellule H est remplie en jaune, la celluleI est remplie en violet, la cellule J est remplie en rouge, la cellule K est remplie en vert et la cellule L est remplie en marron la cellule M doit être remplie en vert puisqu'il y a 5 cases vertes, 2 jaunes 1 violette et 1 rouge et 1 marron.

Enfin si aucune couleur n'a la majorité ---> laisser la case vide pour que je puisse remplir la cellule après analyse.

Merci par avance pour votre aide.

Cordialement.

[Patrice740]

Bonjour,

C'est pas un bug, c'est un manque.
Pour que le compilateur comprenne ce code, il faut établir une référence à Microsoft Scripting Runtime :
Dans le VBE :Outils /Reférences .../Cocher la case correspondante

[Dautomne]

Bonjour,

C'est pas un bug, c'est un manque.
Pour que le compilateur comprenne ce code, il faut établir une référence à Microsoft Scripting Runtime :
Dans le VBE :Outils /Reférences .../Cocher la case correspondante

Bonjour,

Merci pour ton aide :-)

Le résultat de mon code ressort "erroné" : seul le remplissage de la cellules H5 a été pris en compte et pas celui des autres cellules C5:G5 et J5:L5 . Je pense que c'est lié aux codes couleurs repris dans les macros mais je n'en suis pas sûre

exemples :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Range("D5").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "='Fiche de contrôle'!$D$183=""PARTIELLEMENT RECUPERE"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = -0.249946592608417 'Couleur orange
    End With

Si mon analyse est juste, peux-tu me montrer comment modifier ces codes couleurs ; j'ai essayé ceci pour la couleur grise mais les cases se sont remplies en noir donc j'ai certainement fait une erreur

Code initial :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "='Fiche de contrôle'!$D$262="""""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.349986266670736

Code après mon test :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "='Fiche de contrôle'!$D$262="""""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 48
        .TintAndShade = 0

Enfin dernière question, le code initial prend en compte les cellules remplies en gris peux tu me le modifier pour quil les exclut du résultat.

J'ai besoin dans la cellule M5 d'un résultat brut avec prise en compte de toutes les couleurs.

Et dans la cellule N5 d'un résultat net qui exclut la couleur grise.

Je remets le code initial ci après :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub TEST()
Dim rg As Range, cl As Range, colors As Scripting.Dictionary, col As Long, maxnb As Long, colmax As Long, koul
Set rg = Range("C5:L5")
Set colors = New Scripting.Dictionary
For Each cl In rg
    col = cl.Interior.Color
    Select Case col
        Case vbWhite, 8421504:
        Case Else:
            If colors.Exists(col) Then
                colors(col) = colors(col) + 1
            Else
                Call colors.Add(col, 1)
            End If
 
    End Select
Next cl
colmax = 0
maxnb = 0
For Each koul In colors.keys
    If colors(koul) > maxnb Then
        maxnb = colors(koul)
        colmax = koul
    End If
Next koul
Sheets("Synthèse résultats ctrl période").Range("M5").Interior.Color = colmax
End Sub

Merci par avance pour tes explications :-)

Cordialement

[ARTURO83]

Bonjour,

Ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub TEST()
    Dim rg As Range, cl As Range, colors As Object, col As Long, maxnb As Long, colmax As Long, koul
    Set rg = Range("c5:l5")
    Set colors = CreateObject("Scripting.Dictionary")
    For Each cl In rg
        col = cl.Interior.Color
        Select Case col
            Case vbWhite, 8421504:
            Case Else:
                If colors.Exists(col) Then
                    colors(col) = colors(col) + 1
                Else
                    Call colors.Add(col, 1)
                End If
 
        End Select
    Next cl
    colmax = 0
    maxnb = 0
    For Each koul In colors.keys
        If colors(koul) > maxnb Then
            maxnb = colors(koul)
            colmax = koul
        End If
    Next koul
    Sheets("Synthèse résultats ctrl période").Range("M5").Interior.Color = colmax
End Sub

Cdlt

[Dautomne]

Bonjour,

Merci pour ta réponse :-)

Je viens de tester le code et j'ai toujours le même souci seul le résultat de la case H5 est pris en compte. Comme je l'indiquais plus avant il semble que ça soit lié aux codes couleurs utilisés dans mes autres macros.

Étant totalement novice en vba je n'ai pas réussi à modifier correctement ces codes couleurs puisque le remplissage de la case est passé de gris à noir or je souhaite bien du gris.

Code initial :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "='Fiche de contrôle'!$D$262="""""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.349986266670736 '= gris dans ma macro

Code modifié avec erreur visiblement :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "='Fiche de contrôle'!$D$262="""""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 48
        .TintAndShade = 0

Peux tu corriger ce code pour que je puisse modifier correctement l'ensemble des macros?

Et me donner les codes pour les couleurs verte orange rouge.

Merci par avance pour ton aide.

Cordialement

[ARTURO83]

Je viens de tester le code et j'ai toujours le même souci seul le résultat de la case H5 est pris en compte.

Je ne comprends pas, voici un fichier exemple reprenant votre code, testez-le:
Pièce jointe 575838