macro sur changement de couleurs en excel Résolu/Fermé

Question

Bonjour,

Sur excel 2003

Je souhaiterais changer la couleur de plusieurs cellules seulement si elle sont de couleur numéro 4.

J'arrive à sélectionner la plage mais pas à changer la couleur de toutes les cellules.

J'ai cette macro:

Private Sub CommandButton1_Click()
Range("a1:q29").Select
If ActiveCell.Interior.ColorIndex = 4 Then ActiveCell.Interior.ColorIndex = xlColorIndexNone
End Sub
 Merci de votre aide

eriiic · Answer

Bonjour,

En reprenant un peu ton code :
Private Sub CommandButton1_Click()
for each cel in Range("a1:q29")
If Cel.Interior.ColorIndex = 4 Then Cel.Interior.ColorIndex = xlColorIndexNone
next cel
End Sub

triwix · Answer

Bonsoir,

Je te remercie beaucoup.

la vba rentre doucement mais surement.

J'ai une autre question pour completter mon travail, je m'explique, cette macro sert à initialiser un formulaire dont je change la couleur des cases une à une, ma macro de départ est la suivante (en raccourci)

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("A:Q")) Is Nothing Then Exit Sub
If ActiveCell.Interior.ColorIndex = xlColorIndexNone Then ActiveCell.Interior.ColorIndex = 4 Else ActiveCell.Interior.ColorIndex = xlColorIndexNone

If Range("a3").Interior.ColorIndex = 4 Then
Range("b3") = 1
Else
Range("b3") = 0
End If
If Range("A5").Interior.ColorIndex = 4 Then
Range("b5") = 1
Else
Range("b5") = 0
End If
If Range("a7").Interior.ColorIndex = 4 Then
Range("b7") = 1
Else
Range("b7") = 0
End If
If Range("a25").Interior.ColorIndex = 4 Then
Range("b25") = 1
Else
Range("b25") = 0
End If
If Range("a27").Interior.ColorIndex = 4 Then
Range("b27") = 1
Else
Range("b27") = 0
End If
If Range("a13").Interior.ColorIndex = 4 Then
Range("b13") = 1
Else
Range("b13") = 0
End If
If Range("A15").Interior.ColorIndex = 4 Then
Range("b15") = 1
End sub

Donc ta macro blanchi bien toutes mes cellules, mais les cellules qui détectent la couleur verte reste à 1 comme si la cellule adjacente l'était encore.
D'où ma question: comment lancer la vérification des couleurs sans retapper:
Private Sub CommandButton1_Click()
For Each cel In Range("a1:q29")
If cel.Interior.ColorIndex = 4 Then cel.Interior.ColorIndex = xlColorIndexNone
Next cel
If Range("a3").Interior.ColorIndex = 4 Then
Range("b3") = 1
Else
Range("b3") = 0
End If
If Range("A5").Interior.ColorIndex = 4 Then
Range("b5") = 1
Else
Range("b5") = 0
End If
If Range("a7").Interior.ColorIndex = 4 Then
Range("b7") = 1
Else
Range("b7") = 0
End If
If Range("a25").Interior.ColorIndex = 4 Then
Range("b25") = 1
....

QUi est très long est lourd

De même y a t'il moyen d'allèger cette macro qui compte 90 fois:

If Range("a7").Interior.ColorIndex = 4 Then
Range("b7") = 1
Else
Range("b7") = 0
End If


Merci d'avance d'avoir essayé de comprendre mon explication qui je crois n'est claire que pour moi

Bonne soirée

eriiic · Answer

Bonsoir,

si une partie de macro doit être exécutée plusieurs fois il est préférable de la ressortir dans un sub et de l'appeler.
Pour simplifier ton code tu peux sélectionner toutes les cellules concernées et nommer cette plage (plage1 par exemple) et mettre par exemple:
    For Each c In [plage1]
        If c.Interior.ColorIndex = 4 Then
            c.offset(0,1) = 1
        Else
            c.offset(0,1) = 0
        End If
    Next c

eric

triwix · Answer

Bonsoir,

OK je te remercie. 
La dernière macro est bien plus concise, mais dans mon cas le temps de calcul est rallongé, donc je l'ai transformé en :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("A:Q")) Is Nothing Then Exit Sub
If ActiveCell.Interior.ColorIndex = xlColorIndexNone Then ActiveCell.Interior.ColorIndex = 4 Else ActiveCell.Interior.ColorIndex = xlColorIndexNone

        If ActiveCell.Interior.ColorIndex = 4 Then
            ActiveCell.Offset(0, 1) = 1
        Else
            ActiveCell.Offset(0, 1) = 0
        End If

Cancel = True
End Sub

Et c'est pile poil ce qu'il me fallait.

A bientôt

Macro sur changement de couleurs en excel

4 réponses

Discussions similaires