Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Macro qui fait ça :

4 réponses
Avatar
loup
Bonjour,

Je voudrais faire une condition dans ma macro qui ferait=20
cela :

Si Texte dans cellule C6 est de Couleur Rouge Alors
Ecrire ROUGE dans C7 sinon Ecrire NOIR

Je n'arrive pas =E0 trouver la fonction pour la couleur du=20
texte de la cellule C6.

Merci aux personnes pouvant m'aider.

4 réponses

Avatar
Emcy
Salut,

voila la commande qui pourras t'aider :

Range("A1").Font.Color

ça te va ?

-----Message d'origine-----
Bonjour,

Je voudrais faire une condition dans ma macro qui ferait
cela :

Si Texte dans cellule C6 est de Couleur Rouge Alors
Ecrire ROUGE dans C7 sinon Ecrire NOIR

Je n'arrive pas à trouver la fonction pour la couleur du
texte de la cellule C6.

Merci aux personnes pouvant m'aider.
.



Avatar
Michel Gaboly
Bonjour Loup,

Voici un exemple de code.

Sub RougeouNoir()
If Range("C6").Font.ColorIndex = 3 Then
Range("C7") = "Rouge"
Else
Range("C7") = "Noir"
End If
End Sub

En remplaçant le If ... End If par Un Select Case, tu peux aisément gérer
plusieurs couleurs.


Bonjour,

Je voudrais faire une condition dans ma macro qui ferait
cela :

Si Texte dans cellule C6 est de Couleur Rouge Alors
Ecrire ROUGE dans C7 sinon Ecrire NOIR

Je n'arrive pas à trouver la fonction pour la couleur du
texte de la cellule C6.

Merci aux personnes pouvant m'aider.


--
Cordialement,

Michel Gaboly
http://www.gaboly.com

Avatar
Pascal
salut
Une macro qui pourra t'aider aussi

Sub MainMenu()
'commande du menu contextuel des cellules
'exécuter une fois, ou mettre dans le Workbook_AddinInstall
'd'une macro complémentaire
Dim mCtrl As CommandBarPopup

Set mCtrl = Application.CommandBars("Cell"). _
Controls.Add(msoControlPopup, before:=1)
With mCtrl
.Caption = "Somme par couleur"
.OnAction = "AddCouleurs"
End With

End Sub

Private Sub AddCouleurs()
'ajoute à la commande du menu contextuel des cellules
'autant d'entrées qu'il y a de couleurs utilisées dans la feuille active
Dim mCtrl As CommandBarPopup, bCtrl As CommandBarButton

Set mCtrl = Application.CommandBars("Cell"). _
Controls("Somme par couleur")

For I = mCtrl.Controls.Count To 1 Step -1
mCtrl.Controls(I).Delete
Next

CouleursUtilisées

With mCtrl.Controls.Add(msoControlButton)
.Caption = "Couleurs dans la feuille :"
End With

For I = LBound(tabCouleurs) To UBound(tabCouleurs)
With mCtrl.Controls.Add(msoControlButton)
.Caption = NomCouleur(tabCouleurs(I)) & " (" & tabCouleurs(I) & ")"
.FaceId = 2170
.OnAction = "'Compte """ & tabCouleurs(I) & """'"
End With
Next

' 'plus une pour détruire le menu si besoin (pas forcément utile...)
' Set bCtrl = mCtrl.Controls.Add(msoControlButton)
' With bCtrl
' .Caption = "Détruire ce menu"
' .FaceId = 3265
' .BeginGroup = True
' .OnAction = "DelMainMenu"
' End With

End Sub

Sub Compte(IndexCouleur)
'procédure OnAction des commandes de chaque couleur
'la fonction de somme des cellules de la couleur choisie
'est inscrite dans la cellule active
Dim plage As Range, Msg$

Msg = "Sélectionnez la plage qui contient" & vbLf
Msg = Msg & "les cellules de couleur '" & _
NomCouleur(CLng(IndexCouleur)) & "'" & vbLf
Msg = Msg & "que vous voulez additionner :"

'choix de la plage qui contient les cellules à sommer
On Error Resume Next
Set plage = Application.InputBox(Msg, "Somme par couleur", , , , , , 8)
If plage Is Nothing Then Exit Sub

'la cellule active ne doit pas être dans la plage examinée
If Not Intersect(plage, ActiveCell) Is Nothing Then
Msg = "La cellule active fait partie de la plage à examiner." & vbLf
Msg = Msg & "Risque de référence circulaire. Abandon !"
MsgBox Msg, , "Somme par couleur"
Exit Sub
End If

'si la cellule active n'est pas libre
If Not IsEmpty(ActiveCell) Then
If MsgBox("La cellule active n'est pas vide. Continuer ?", vbYesNo, _
"Somme par couleur") = vbNo Then Exit Sub
End If

'renvoi de la formule dans la cellule active
ActiveCell.FormulaLocal = _
"=SommeSelonCouleur(" & plage.Address(0, 0) & ";" & CLng(IndexCouleur)
& ")"

End Sub

'pour faire la somme des cellules *sans* couleur, passer -4142 pour Couleur
Function SommeSelonCouleur(Plage_à_examiner As Range, _
Couleur_à_sommer As Long) As Double
'L Longre, mpfe
Dim Arr, I As Long, J As Integer
Application.Volatile True
Arr = Plage_à_examiner
For I = 1 To UBound(Arr, 1)
For J = 1 To UBound(Arr, 2)
If Plage_à_examiner(I, J).Interior.ColorIndex = _
Couleur_à_sommer Then
SommeSelonCouleur = SommeSelonCouleur + Arr(I, J)
End If
Next J
Next I
End Function

Sub DelMainMenu()
'détruit la commande principale du menu contextuel des cellules
'(à mettre éventuellement dans l'événement Workbook_AddinUninstall
'd'une macro complémentaire)
On Error Resume Next
Application.CommandBars("Cell"). _
Controls("Somme par couleur").Delete
End Sub

'*****Traitements des tableaux globaux*****

Private Function NomCouleur(Idx) As String
'renvoi le nom de la couleur dans la palette d'Excel à partir de l'index

' si ce module est utilisé dans une macro complémentaire, mettez cet
' appel en commentaire et reportez-le dans le Workbook_Open
InitNomsCouleurs
For I = 1 To 41
If tabColors(I, 1) = Idx Then
NomCouleur = tabColors(I, 2)
Exit Function
End If
Next
End Function

Private Sub CouleursUtilisées()
'remplit le tableau des couleurs utilisées dans la feuille active
'xlNone=-4142
Dim Vue As Boolean, I&, J&, cell As Range
Dim IdxCouleur&

I = 0
ReDim tabCouleurs(0)

For Each cell In ActiveSheet.UsedRange
If cell.Interior.ColorIndex <> -4142 Then
Vue = False
IdxCouleur = cell.Interior.ColorIndex
For J = LBound(tabCouleurs) To UBound(tabCouleurs)
If tabCouleurs(J) = IdxCouleur Then
Vue = True: Exit For
End If
Next
If Not Vue Then
tabCouleurs(I) = IdxCouleur
I = I + 1
ReDim Preserve tabCouleurs(I)
End If
End If
Next

tabCouleurs(I) = -4142

End Sub

Sub InitNomsCouleurs()
'remplit le tableau qui donne l'équivalence entre le ColorIndex
'et le nom de la couleur dans la palette d'Excel
'(à appeler dans le Workbook_Open d'une macro complémentaire)
tabColors(1, 1) = 1: tabColors(1, 2) = "Noir"
tabColors(2, 1) = 9: tabColors(2, 2) = "Rouge foncé"
tabColors(3, 1) = 3: tabColors(3, 2) = "Rouge"
tabColors(4, 1) = 7: tabColors(4, 2) = "Rose"
tabColors(5, 1) = 38: tabColors(5, 2) = "Rose saumon"
tabColors(6, 1) = 53: tabColors(6, 2) = "Marron"
tabColors(7, 1) = 46: tabColors(7, 2) = "Orange"
tabColors(8, 1) = 45: tabColors(8, 2) = "Orange clair"
tabColors(9, 1) = 44: tabColors(9, 2) = "Or"
tabColors(10, 1) = 40: tabColors(10, 2) = "Brun"
tabColors(11, 1) = 52: tabColors(11, 2) = "Vert olive"
tabColors(12, 1) = 12: tabColors(12, 2) = "Marron clair"
tabColors(13, 1) = 43: tabColors(13, 2) = "Citron vert"
tabColors(14, 1) = 6: tabColors(14, 2) = "Jaune"
tabColors(15, 1) = 36: tabColors(15, 2) = "Jaune clair"
tabColors(16, 1) = 51: tabColors(16, 2) = "Vert foncé"
tabColors(17, 1) = 10: tabColors(17, 2) = "Vert"
tabColors(18, 1) = 50: tabColors(18, 2) = "Vert marin"
tabColors(19, 1) = 4: tabColors(19, 2) = "Vert brillant"
tabColors(20, 1) = 35: tabColors(20, 2) = "Vert clair"
tabColors(21, 1) = 49: tabColors(21, 2) = "Bleu-vert foncé"
tabColors(22, 1) = 14: tabColors(22, 2) = "Bleu-vert"
tabColors(23, 1) = 42: tabColors(23, 2) = "Vert d'eau"
tabColors(24, 1) = 8: tabColors(24, 2) = "Turquoise"
tabColors(25, 1) = 34: tabColors(25, 2) = "Turquoise clair"
tabColors(26, 1) = 11: tabColors(26, 2) = "Bleu foncé"
tabColors(27, 1) = 5: tabColors(27, 2) = "Bleu"
tabColors(28, 1) = 41: tabColors(28, 2) = "Bleu clair"
tabColors(29, 1) = 33: tabColors(29, 2) = "Bleu ciel"
tabColors(30, 1) = 37: tabColors(30, 2) = "Bleu moyen"
tabColors(31, 1) = 55: tabColors(31, 2) = "Indigo"
tabColors(32, 1) = 47: tabColors(32, 2) = "Bleu-gris"
tabColors(33, 1) = 13: tabColors(33, 2) = "Violet"
tabColors(34, 1) = 54: tabColors(34, 2) = "Prune"
tabColors(35, 1) = 39: tabColors(35, 2) = "Lavande"
tabColors(36, 1) = 56: tabColors(36, 2) = "Gris-80%"
tabColors(37, 1) = 16: tabColors(37, 2) = "Gris-50%"
tabColors(38, 1) = 48: tabColors(38, 2) = "Gris-40%"
tabColors(39, 1) = 15: tabColors(39, 2) = "Gris-25%"
tabColors(40, 1) = 2: tabColors(40, 2) = "Blanc"
tabColors(41, 1) = -4142: tabColors(41, 2) = "(Aucune)"
End Sub

"Emcy" a écrit dans le message de
news: 07c701c3a373$e20c4f90$
Salut,

voila la commande qui pourras t'aider :

Range("A1").Font.Color

ça te va ?

-----Message d'origine-----
Bonjour,

Je voudrais faire une condition dans ma macro qui ferait
cela :

Si Texte dans cellule C6 est de Couleur Rouge Alors
Ecrire ROUGE dans C7 sinon Ecrire NOIR

Je n'arrive pas à trouver la fonction pour la couleur du
texte de la cellule C6.

Merci aux personnes pouvant m'aider.
.



Avatar
loup
Merci à vous tous pour vos réponses !
Je pense que je devrais m'en sortir avec tout ça :)
MERCI

-----Message d'origine-----
Bonjour,

Je voudrais faire une condition dans ma macro qui ferait
cela :

Si Texte dans cellule C6 est de Couleur Rouge Alors
Ecrire ROUGE dans C7 sinon Ecrire NOIR

Je n'arrive pas à trouver la fonction pour la couleur du
texte de la cellule C6.

Merci aux personnes pouvant m'aider.
.