Code VBA Couleur cellule

Le 13/07/2023 à 10:29

Bonjour à tous :)

Voila j'aurais voulu mettre mes cellules en couleur en fonction d'un mot style caristes, mécanicien ;

voici le début du code que j'ai commencé , pouvez m'aider à terminer ou à comprendre comment je peux terminer mon code

Rows(drn_site + 1).EntireRow.AutoFit
Range("A" & drn_site + 1).Select
With Selection.Interior

.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
Select Case Range("A" & drn_site + 1).Value
Case "Caristes"
.TintAndShade =(255,255,153)
Case "Mécaniciens"
.TintAndShade =

Case "Ensemble des salariés"
.TintAndShade =

Case "Conducteur"
.TintAndShade =

End Select
.PatternTintAndShade = 0

Voila le résultat que je souhaiterais

image

Merci par avance de votre aide

Bonne journée :)

Le 13/07/2023 à 10:59

Bonjour Fanny,

En préambule, on est d'accord sur le fait que "mettre une cellule en couleur en fonction d'un mot" ... ça peut se faire à l'aide d'une Mise en Forme Conditionnelle ?
Alors, pourquoi une macro ?

D'autre part, comme on ne dispose que d'un extrait de ton code, on ne sait pas s'il s'agit d'une procédure "standard" ou d'une procédure événementielle, si le code figure dans un module standard, celui d'une feuille, de toutes les feuilles, du 'ThisWorkbook', etc.

Quelques mots sur le contexte, le nombre de fonctions (et donc de couleurs) à prendre en compte, ainsi qu'un bout de fichier en support, seront les bienvenus !

Le 13/07/2023 à 11:10

Merci pour ta réponse donc mon code se trouve dans un module général : voici le code complet du module :

Sub chgt_PA()

'REPORT ACTIONS TERMINEES
'déclar variables
Dim i%, j%, drn_histo%, drn_PA%, drn_site%, nom_site%, i_site, i_site_fusion, num_cas
Dim PA As Worksheet, histo As Worksheet, site As Worksheet
Dim Risque$, actionProj$, nomfeuille$

' récupération du numéro du site
nomfeuille = ActiveSheet.Name
nom_site = Right(nomfeuille, 2)

' numéro de la ligne à traiter sur PA
If PA_42.ligne = 0 And PA_84.ligne = 0 And PA_16.ligne = 0 And PA_44.ligne = 0 And PA_59.ligne = 0 And PA_68.ligne = 0 Then
i = ActiveCell.Row
Else
i = PA_42.ligne + PA_84.ligne + PA_16.ligne + PA_44.ligne + PA_59.ligne + PA_68.ligne
End If

i_site = 5
i_site_fusion = i_site
num_cas = 0

' test si le champ date réalisation est renseigné
If Range("I" & i).Value = "" Then
MsgBox ("la date de réalisation n'est pas remplie pour la ligne " & i)
Exit Sub
End If
' test si le champ action récurrente est renseigné
If Range("E" & i).Value = "" Then
MsgBox ("la notion de récurrence n'est pas remplie pour la ligne " & i)
Exit Sub
End If

'création des pages
Set PA = Sheets("PA " & nom_site)
Set histo = Sheets("Histo " & nom_site)
Set site = Sheets("Site " & nom_site)
drn_histo = histo.Range("A1000").End(xlUp).Row
'désactive le rafraîchissement d'excel
Application.ScreenUpdating = False

Risque = Range("B" & i): actionProj = Range("D" & i)

If Range("E" & i).Value = "OUI" Then
site.Activate
drn_site = site.Range("G7").End(xlDown).Row

' CAS 1 : la ligne existe (personnel/rubrique/action), mise à jour de la date de réalisation
' CAS 2 : la ligne n'existe pas (personnel/rubrique/action), mais le couple personnel/risque existe => insertion d'une ligne en cours de tableau pour ajouter l'action
' CAS 3 : la ligne n'existe pas (personnel/rubrique/action) et le couple personnel/risque n'existe pas => insertion d'une ligne en fin de tableau pour ajouter l'action

While site.Range("G" & i_site).Value <> "" And num_cas = 0
i_site_fusion = i_site
' test si A et B correspondent au bon couple rubrique personnel/risque
If site.Range("B" & i_site) = Risque And site.Range("A" & i_site) = PA.Range("A" & i) Then
If site.Range("G" & i_site) = actionProj Then
' mise à jour de la date de réalisation : CAS 1
site.Range("I" & i_site).Value = PA.Range("I" & i)
num_cas = 1
End If
While site.Range("A" & i_site_fusion + 1).Value = "" And num_cas = 0
If site.Range("G" & i_site_fusion) = actionProj Then
' mise à jour de la date de réalisation : CAS 1
site.Range("I" & i_site_fusion).Value = PA.Range("I" & i)
num_cas = 1
Else
i_site_fusion = i_site_fusion + 1
End If
Wend
If num_cas = 0 Then
' CAS 2 : insertion d'une ligne avec un couple personnel/risque existant
i_site_fusion = i_site_fusion + 1
Rows(i_site_fusion).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
' suppression des lignes éventuelles en trop
While site.Range("A" & i_site_fusion + 1).Value = ""
Rows(i_site_fusion).Select
Selection.Delete Shift:=xlUp
Wend
' récupération des données de PA (ici seulement l'action
site.Range("G" & i_site_fusion) = actionProj
' fusion des colonnes A, B, C, D et E
Range("A" & i_site & ": A" & i_site_fusion).Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.MergeCells = True
End With
Range("B" & i_site & ": B" & i_site_fusion).Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.MergeCells = True
End With
Range("C" & i_site & ": C" & i_site_fusion).Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.MergeCells = True
End With
Range("D" & i_site & ": D" & i_site_fusion).Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.MergeCells = True
End With
Range("E" & i_site & ": E" & i_site_fusion).Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.MergeCells = True
End With
Range("F" & i_site & ": F" & i_site_fusion).Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.MergeCells = True
End With
Range("J" & i_site & ": J" & i_site_fusion).Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.MergeCells = True
End With
Range("K" & i_site & ": K" & i_site_fusion).Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.MergeCells = True
End With
site.Range("G" & i_site_fusion).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark2
.TintAndShade = 0
.PatternTintAndShade = 0
End With

num_cas = 2
' mise à jour de la date de réalisation : CAS 2
site.Range("I" & i_site_fusion).Value = PA.Range("I" & i)
num_cas = 2
End If
End If

i_site = i_site + 1
Wend
' CAS 3
If num_cas = 0 Then
num_cas = 3
site.Range("A" & drn_site + 1) = PA.Range("A" & i)
site.Range("G" & drn_site + 1) = actionProj
site.Range("B" & drn_site + 1) = Risque
site.Range("I" & drn_site + 1).Value = PA.Range("I" & i)
' mise en forme de la nouvelle ligne créée
Range("A" & drn_site + 1 & ":K" & drn_site + 1).Select
' Selection.Borders(xlDiagonalDown).LineStyle = xlNone
' Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Font.Bold = True
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows(drn_site + 1).EntireRow.AutoFit
Range("A" & drn_site + 1).Select
With Selection.Interior

.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
Select Case Range("A" & drn_site + 1).Value
Case "Caristes"
.TintAndShade =(255,255,153)
Case "Mécaniciens"
.TintAndShade = -0.249977111117893
End Select
.PatternTintAndShade = 0


End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlCenter
End With
site.Range("G" & i_site).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark2
.TintAndShade = 0
.PatternTintAndShade = 0
End With
site.Range("I" & i_site).Select
Selection.NumberFormat = "dd/mm/yy;@"
End If
End If

'transfert vers l'historique
histo.Activate
histo.Range("A" & drn_histo + 1) = PA.Range("A" & i)
histo.Range("B" & drn_histo + 1) = PA.Range("B" & i)
histo.Range("C" & drn_histo + 1) = PA.Range("C" & i)
histo.Range("D" & drn_histo + 1) = PA.Range("D" & i)
histo.Range("E" & drn_histo + 1) = PA.Range("E" & i)
histo.Range("F" & drn_histo + 1) = PA.Range("F" & i)
histo.Range("G" & drn_histo + 1) = PA.Range("G" & i)
histo.Range("H" & drn_histo + 1) = PA.Range("H" & i)
histo.Range("I" & drn_histo + 1) = PA.Range("I" & i)
histo.Range("J" & drn_histo + 1) = PA.Range("J" & i)
histo.Range("K" & drn_histo + 1) = PA.Range("K" & i)
histo.Range("L" & drn_histo + 1) = PA.Range("L" & i)
histo.Range("M" & drn_histo + 1) = PA.Range("M" & i)

'suppression
PA.Activate
Rows(i).EntireRow.Delete

End Sub

Sub test()

Dim i As Integer

i = 120

While i < 125

MsgBox (Range("A" & i).Value)

i = i + 1
Wend

End Sub

Le 13/07/2023 à 11:12

Il me faut 4 couleurs, une pour chacun des mots suivant caristes, conducteurs, ensemble des salariés et mécaniciens

Le 13/07/2023 à 13:20

Re-bonjour,

Le mieux serait de répondre à toutes les questions : il y a des "choses" dans ton code qui posent plus de questions qu'elles n'éclairent (par exemple la série de
If PA_42.ligne = 0 And PA_84.ligne = 0 And PA_16.ligne = 0 etc. !?) La syntaxe est -pour le moins- inhabituelle . Le code en question a été généré par une IA ?

Par rapport à ta question initiale, si tu as un Select Case, suivi de deux Case ... qu'est-ce qui t'empêche de continuer sur cette voie (même si, là aussi, la différence entre les instructions suivant chaque Case laisse perplexe)

Pour notre confort, ton code sera plus lisible si tu utilises les balises (comme dans ton premier message)

On sait maintenant

  • que le code figure dans un module standard
  • que la partie "mise en couleurs" s'intègre au reste (c'est pour ça que tu ne réponds pas à la question sur la MFC ?)
  • que tu auras 4 couleurs (3 fonctions et "ensemble des salariés", si j'ai compris)

Qu'est-ce qui déclenche l'exécution du code ? Si c'est un bouton dans une feuille, ActiveSheet.Name aura du sens ... si c'est un raccourci clavier, il pourrait s'agir de n'importe quelle feuille !
Pour ce qui est d'expliquer le contexte et de joindre un bout de fichier, on reste un peu sur sa faim !

Le 13/07/2023 à 14:22

Bonjour

pour répondre a ta question sur l'exemple PA ,non cela n'a pas été génère par un IA .

Mon code fonction grace à un plan d'action et a d'autre code vba

Rechercher des sujets similaires à "code vba couleur"