2 macros pour une feuille

Bonjour,

Je viens de me faire un tableau avec une macro qui me colore une ligne en fonction d'une donnée dans une cellule avec la formule suivante:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 3 _
And Target.Row >= 2 Then
If UCase(Target.Value) = "Analogique" Then
Target.EntireRow.Interior.ColorIndex = 3
Else
Target.EntireRow.Interior.ColorIndex = 0
End If
End If
End Sub

Ma question est la suivante:

Je dois pouvoir colorer plusieurs lignes (plus de 9000) avec plusieurs couleurs (8)
La cellule qui détermine la couleur est une cellule à choix multiples (menu déroulant)
J'ai vu la mise en forme conditionnelle mais c'est limité à 3 conditions.
J'ai essaie de mettre 2X la même macro avec une valeur de colorindex et de target value (Analogique, Digital, ...) différentes mais ça ne fonctionne pas.
Seule la dernière macro est prise en compte.

Pouvez vous m'aider?
Merci

5 réponses

  • Votes
  • Date
  • Date décroissante
  1. Bonjour,

    Si j'ai bien compris, ceci devrait résoudre ton problème,

    il ne reste qu'a définir le code pour chaque couleur.

    Option Explicit    
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)    
    
        If Target.Column = 3 And Target.Row >= 2 Then    
            
            Dim Couleur As Integer    
                
            Select Case (Target.Value)    
                Case "Analogique"    
                    Couleur = 3    
                Case "Numérique"    
                    Couleur = 5    
                ' Etc ...    
                Case Else    
                    Couleur = 0    
            End Select    
                
            Call AppliqueCouleur(Target, Couleur)    
                
        End If    
    End Sub    
    '    
    
    Private Sub AppliqueCouleur(ByVal Cible As Range, ByVal Couleur As int32)    
    
        Cible.EntireRow.Interior.ColorIndex = Couleur    
    
    End Sub    
    '    
    


    Cdt

    Lupin
    1. en y repanssant,

      s'il y a plusieurs lignes à tester :

      Tu devrais enlever le critère de ligne :

      If Target.Column = 3 And Target.Row >= 2 Then

      devient :

      If Target.Column = 3 Then

      Cdt

      Lupin
    2. Bonjour et déjà merci pour l'aide mais si je fais un copier/coller de la formule, j'ai un résultat erroné:

      erreur de compilation.
      Type défini par utilisateur non défini.
      et la ligne "If target.Column = 6" se met en rouge.

      Quel est le problème?
      Merci encore.

      Option Explicit

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)

      If Target.Column = 6

      Dim Couleur As Integer

      Select Case (Target.Value)
      Case "Analogique"
      Couleur = 3
      Case "Numérique"
      Couleur = 5
      Case Else
      Couleur = 0
      End Select

      Call AppliqueCouleur(Target, Couleur)

      End If
      End Sub
      '

      Private Sub AppliqueCouleur(ByVal Cible As Range, ByVal Couleur As int32)

      Cible.EntireRow.Interior.ColorIndex = Couleur

      End Sub
      '
  2. re:

    désolé, je code trop en .NET ces temps-ci :

    Modifie cette partie :

    Private Sub AppliqueCouleur(ByVal Cible As Range, ByVal Couleur As Integer) 
    
          Cible.EntireRow.Interior.ColorIndex = Couleur 
    
    End Sub 
    


    Cdt

    Lupin
    1. re :

      Tu pourrais faire une bascule au cas ou il ait une erreur de manipulation :

      Option Explicit
      
      
      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
          
          If Target.Column = 6 Then
              
              Dim Couleur As Integer
                  
              Select Case (Target.Value)
                  Case "Analogique"
                      If (Target.EntireRow.Interior.ColorIndex = 3) Then
                          Couleur = 0
                      Else
                          Couleur = 3
                      End If
                  Case "Numérique"
                      If (Target.EntireRow.Interior.ColorIndex = 5) Then
                          Couleur = 0
                      Else
                          Couleur = 5
                      End If
                  ' Etc ...
                  Case Else
                      Couleur = 0
              End Select
                  
              Call AppliqueCouleur(Target, Couleur)
                  
          End If
      End Sub
      '
      
      Private Sub AppliqueCouleur(ByVal Cible As Range, ByVal Couleur As Integer)
      
          Cible.EntireRow.Interior.ColorIndex = Couleur
      
      End Sub
      '
      


      Cdt

      Lupin
      1. Oula !
        Joli, merci beaucoup.
        J'ai une question néanmoins.
        La bascule c'est quoi ? C'est que a chaque fois que je click sur une cellule colorée, elle repasse en blanc?

        Version avec bascule, numéro et thermes OK.

        Pour ne pas avoir le repassage en transparent avec le re-click, ça se passe comment?
        j'imagine qu'il faut supprimer la ligne " then couleur =0 mais suis pas sûr.
        Comment faire.

        BàT

        Didier
        1. re:

          En effet, la bascule est pour défaire la première instruction,
          si tu as fait une erreur, un nouveau click defait la couleur.

          en remplaçant
           If (Target.EntireRow.Interior.ColorIndex = 3) Then
                 Couleur = 0
           Else
                 Couleur = 3
           End If
          


          par

          Couleur = 3

          tu enlève cette option !

          le
          Case Else
                          Couleur = 0
          


          défait aussi la couleur si la valeur "Analogique", ou l'une des valeurs
          cités dans les "case" n'est pas rencontré.

          c'est la même chose que d'écrire
          Case ""
                          Couleur = 0
          

          qui aurait le même effet pour défaire la couleur

          Cdt

          Lupin