Pb vba
nikos
-
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
Je suis en train de travailler sur un tableau pour les horaires d'un établissement. Le but est de colorier une selection de cellule en fonction d'un sigle. exemple.
Sub ChgCouleur()
For Each Sh In Sheets
If Sh.Range("D4").Value = "ca" Then 'LUNDI
Sh.Range("B3:D6").Interior.ColorIndex = 4
ElseIf Sh.Range("d4").Value = "ct" Then
Sh.Range("B3:D6").Interior.ColorIndex = 6
ElseIf Sh.Range("D4").Value = "m" Then
Sh.Range("B3:D6").Interior.ColorIndex = 3
Else
Sh.Range("B3:D6").Interior.ColorIndex = 0
End If
If Sh.Range("G4").Value = "ca" Then 'MARDI
Sh.Range("E3:G6").Interior.ColorIndex = 4
ElseIf Sh.Range("G4").Value = "ct" Then
Sh.Range("E3:G6").Interior.ColorIndex = 6
ElseIf Sh.Range("G4").Value = "m" Then
Sh.Range("E3:G6").Interior.ColorIndex = 3
Else
Sh.Range("E3:G6").Interior.ColorIndex = 0
End If
If Sh.Range("J4").Value = "ca" Then 'MERCREDI
Sh.Range("H3:J6").Interior.ColorIndex = 4
ElseIf Sh.Range("J4").Value = "ct" Then
Sh.Range("H3:J6").Interior.ColorIndex = 6
ElseIf Sh.Range("J4").Value = "m" Then
Sh.Range("H3:J6").Interior.ColorIndex = 3
Else
Sh.Range("H3:J6").Interior.ColorIndex = 0
End If
If Sh.Range("M4").Value = "ca" Then 'JEUDI
Sh.Range("K3:M6").Interior.ColorIndex = 4
ElseIf Sh.Range("M4").Value = "ct" Then
Sh.Range("K3:M6").Interior.ColorIndex = 6
ElseIf Sh.Range("M4").Value = "m" Then
Sh.Range("K3:M6").Interior.ColorIndex = 3
Else
Sh.Range("K3:M6").Interior.ColorIndex = 0
End If
If Sh.Range("P4").Value = "ca" Then 'VENDREDI
Sh.Range("N3:P6").Interior.ColorIndex = 4
ElseIf Sh.Range("P4").Value = "ct" Then
Sh.Range("N3:P6").Interior.ColorIndex = 6
ElseIf Sh.Range("P4").Value = "m" Then
Sh.Range("N3:P6").Interior.ColorIndex = 3
Else
Sh.Range("N3:P6").Interior.ColorIndex = 0
End If
If Sh.Range("S4").Value = "ca" Then 'SAMEDI DIMANCHE CA
Sh.Range("Q3:S6").Interior.ColorIndex = 4
Sh.Range("T3:V6").Interior.ColorIndex = 4
Else
Sh.Range("Q3:S6").Interior.ColorIndex = 0
Sh.Range("T3:V6").Interior.ColorIndex = 0
If Sh.Range("S4").Value = "ct" Then 'SAMEDI CT M
Sh.Range("Q3:S6").Interior.ColorIndex = 6
ElseIf Sh.Range("S4").Value = "m" Then
Sh.Range("Q3:S6").Interior.ColorIndex = 3
Else
Sh.Range("Q3:S6").Interior.ColorIndex = 0
End If
If Sh.Range("V4").Value = "ct" Then 'DIMANCHE CT M
Sh.Range("T3:V6").Interior.ColorIndex = 6
ElseIf Sh.Range("V4").Value = "m" Then
Sh.Range("T3:V6").Interior.ColorIndex = 3
Else
Sh.Range("T3:V6").Interior.ColorIndex = 0
End If
End If
Next Sh
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub
Cette macro colorie en vert quand il est écrit ca, en rouge ct, etc
tout ceci fonctionne bien pour les lignes 3 à 6 (car j'ai tout nommé). Seulement, j'aimerais que se code s'applique aux lignes 7à 10 aussi. (sans avoir à recopier tout le code et ne changer que des chiffre et des lettres).
Merci de votre aide
Je suis en train de travailler sur un tableau pour les horaires d'un établissement. Le but est de colorier une selection de cellule en fonction d'un sigle. exemple.
Sub ChgCouleur()
For Each Sh In Sheets
If Sh.Range("D4").Value = "ca" Then 'LUNDI
Sh.Range("B3:D6").Interior.ColorIndex = 4
ElseIf Sh.Range("d4").Value = "ct" Then
Sh.Range("B3:D6").Interior.ColorIndex = 6
ElseIf Sh.Range("D4").Value = "m" Then
Sh.Range("B3:D6").Interior.ColorIndex = 3
Else
Sh.Range("B3:D6").Interior.ColorIndex = 0
End If
If Sh.Range("G4").Value = "ca" Then 'MARDI
Sh.Range("E3:G6").Interior.ColorIndex = 4
ElseIf Sh.Range("G4").Value = "ct" Then
Sh.Range("E3:G6").Interior.ColorIndex = 6
ElseIf Sh.Range("G4").Value = "m" Then
Sh.Range("E3:G6").Interior.ColorIndex = 3
Else
Sh.Range("E3:G6").Interior.ColorIndex = 0
End If
If Sh.Range("J4").Value = "ca" Then 'MERCREDI
Sh.Range("H3:J6").Interior.ColorIndex = 4
ElseIf Sh.Range("J4").Value = "ct" Then
Sh.Range("H3:J6").Interior.ColorIndex = 6
ElseIf Sh.Range("J4").Value = "m" Then
Sh.Range("H3:J6").Interior.ColorIndex = 3
Else
Sh.Range("H3:J6").Interior.ColorIndex = 0
End If
If Sh.Range("M4").Value = "ca" Then 'JEUDI
Sh.Range("K3:M6").Interior.ColorIndex = 4
ElseIf Sh.Range("M4").Value = "ct" Then
Sh.Range("K3:M6").Interior.ColorIndex = 6
ElseIf Sh.Range("M4").Value = "m" Then
Sh.Range("K3:M6").Interior.ColorIndex = 3
Else
Sh.Range("K3:M6").Interior.ColorIndex = 0
End If
If Sh.Range("P4").Value = "ca" Then 'VENDREDI
Sh.Range("N3:P6").Interior.ColorIndex = 4
ElseIf Sh.Range("P4").Value = "ct" Then
Sh.Range("N3:P6").Interior.ColorIndex = 6
ElseIf Sh.Range("P4").Value = "m" Then
Sh.Range("N3:P6").Interior.ColorIndex = 3
Else
Sh.Range("N3:P6").Interior.ColorIndex = 0
End If
If Sh.Range("S4").Value = "ca" Then 'SAMEDI DIMANCHE CA
Sh.Range("Q3:S6").Interior.ColorIndex = 4
Sh.Range("T3:V6").Interior.ColorIndex = 4
Else
Sh.Range("Q3:S6").Interior.ColorIndex = 0
Sh.Range("T3:V6").Interior.ColorIndex = 0
If Sh.Range("S4").Value = "ct" Then 'SAMEDI CT M
Sh.Range("Q3:S6").Interior.ColorIndex = 6
ElseIf Sh.Range("S4").Value = "m" Then
Sh.Range("Q3:S6").Interior.ColorIndex = 3
Else
Sh.Range("Q3:S6").Interior.ColorIndex = 0
End If
If Sh.Range("V4").Value = "ct" Then 'DIMANCHE CT M
Sh.Range("T3:V6").Interior.ColorIndex = 6
ElseIf Sh.Range("V4").Value = "m" Then
Sh.Range("T3:V6").Interior.ColorIndex = 3
Else
Sh.Range("T3:V6").Interior.ColorIndex = 0
End If
End If
Next Sh
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub
Cette macro colorie en vert quand il est écrit ca, en rouge ct, etc
tout ceci fonctionne bien pour les lignes 3 à 6 (car j'ai tout nommé). Seulement, j'aimerais que se code s'applique aux lignes 7à 10 aussi. (sans avoir à recopier tout le code et ne changer que des chiffre et des lettres).
Merci de votre aide
1 réponse
Bonjour
macro parametrée A complèter (la flemme)
macro parametrée A complèter (la flemme)
Sub changer_couleur()
Application.Screenupdating=False
For Each sht In Sheets
colorier sht, "D4", "B3:D8"
colorier sht, "G4", "E3:G6"
etc
Next
End Sub
Sub colorier(onglet, test, plage)
With onglet
Select Case .Range(test).Value
Case Is = "ca"
.Range(plage).Interior.ColorIndex = 4
Case Is = "ct"
.Range(plage).Interior.ColorIndex = 6
'case.... à complèter poil dans la main
Case Else
.Range(plage).Interior.ColorIndex = 0
End Select
End With
End Sub
