VBA-Condition "si au moins"

[simyrom]

Bonjour le forum,

Je suis desole, je vais sans doute poser une question qui a ete resolu des millions de fois sur ce forum mais vu les mots communs qu'elle utilise, je n'ai rien trouve. Donc la voici:

Existe t-il une condition du style:
*si au moins une/deux/... cellule(s) dans une plage donnee a telle couleur, alors fait ca
*Si toutes les cellules de cette plage donnee sont de telle couleur, alors fait ca
Normallement ma plage de cellules sera une partie de ligne mais s'il existe une syntaxe generale, je suis preneur.

D'avance merci.
Romain

 

[michel]

Bonjour Simyrom

J'espere que cet exemple pourra t'aider :

Dans la plage de cellules A1:A10 , la procedure compte le nombre de cellules rouges
Et te renvoie deux types de message
1. Un message specifique si toutes les cellules de la plage sont rouges
2. Un autre message comptabilisant le nombre de cellules rouges ,pour tous les autres cas de figure

Sub cptecouleur()

Dim val
Dim i As Integer, j As Integer

j = 0
i = 0

For Each val In Sheets("feuil2").Range("a1:a10")
i = i + 1

If val.Interior.ColorIndex = 3 Then
j = j + 1
End If
Next

Select Case j
Case Is = i
MsgBox "toutes les cellules sont coloriees"
Case Is <> i
MsgBox "il y a " & j & " cellules coloriées"
End Select

End Sub


Bonne apres midi
Michel

 

[Jon_Chninkel]

la macro ci-dessous retourne vrai dans une boîte de message si il y a autant de cellules de couleur 6 dans A1:A5 que de cellules contenues dans cette plage.


Sub demo()
MsgBox [A1:A5].Cells.Count = BgColorcountif([A1:A5], 6)
End Sub

'ATTENTION il ya peut-être un comportement bizarre avec la valeur xlColorIndexNone

Function BgColor(CkCell As Object)
BgColor = Abs(CkCell.Interior.ColorIndex)
End Function

Function BgColorcountif(SearchArea As Object, BgColor As Integer) As Integer
For Each Cell In SearchArea
BgColorcountif = BgColorcountif + Abs(Cell.Interior.ColorIndex = BgColor)
Next Cell
End Function

 

[simyrom]

Bonjour Michel, Jon Chninkel et le forum
Merci pour vos reponses.
Je vais eplucher ca demain (j'ai besoin d'avoir la tete reposee...) et je vous tiendrai au courant.
Merci encore
Romain