Absence de prise en compte des couleurs MFC dans une formule [Fermé]

Signaler
-
Messages postés
14779
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
26 septembre 2020
-
Bonjour à tous,

La formule ci-après fonctionne parfaitement dans mon fichier quand je remplis les cellules (C5:L5) avec des couleurs VBA (résultat cellule M5).

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
Debug.Print col
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


Mon souci, les couleurs reprises dans mon fichier sont à priori en format MFC et semblent exclues du calcul.

Je n'ai aucune compétence en vba, quelqu'un peut-il me modifier ce code pour que les couleurs "MFC" soient prisent en compte dans la formule.

Par ailleurs, est-il possible de modifier le code ci-dessous pour que le format couleur (cellule H5) soit identique aux autres cellules (passage vba en mfc).

'SUIVI FACTURATION

Dim rg As Range, cl As Range, noui As Integer, nnon As Integer, couleur As Integer, ncel As Long
Set rg = Sheets("Fiche de contrôle").Range("$D$295:$D$297")
noui = 0
nnon = 0
ncel = rg.Count
For Each cl In rg
Select Case cl.Value
Case "NON":
nnon = nnon + 1
Case "OUI":
noui = noui + 1
End Select
Next cl
If noui = ncel Then
couleur = 10 'vert
Else
If nnon = ncel Then
couleur = 9 'rouge
Else
If noui + nnon = ncel Then
couleur = 46 'orange
Else
couleur = 48 'gris
End If
End If
End If
Sheets("Synthèse résultats ctrl période").Range("H39").Interior.ColorIndex = couleur

End Sub


Je vous joins mon fichier :

https://www.cjoint.com/c/JGDxx5CfRyO

Merci beaucoup.







Configuration: Windows / Firefox 78.0

1 réponse

Messages postés
14779
Date d'inscription
mardi 11 mars 2003
Statut
Contributeur
Dernière intervention
26 septembre 2020
580