pb vba

Question

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
Configuration: Windows 7 / Firefox 18.0

michel_m · Answer

Bonjour

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

Pb vba

1 réponse

Discussions similaires

Newsletters