XL 2010 Deux codes VBA sur une même feuille

JULIATAZ

XLDnaute Nouveau
Bonjour,

Je souhaite enchainer 2 codes VBA complètement différents sur une même feuille mais cela ne fonctionne pas.
Voici mes 2 souhaits :
1. Changer la couleur d'une feuille en fonction du texte de la cellule D1.
2. Masquer les colonnes X à AE si la cellule I17 est cochée d'un X.

Voici mes 2 codes que je n'arrive pas à enchainer. Mon niveau étant assez faible, Il doit y avoir un problème dans le texte.
Seuls, ils fonctionnent très bien mais sur la même feuille cela ne fonctionne pas.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice
If Target.Address = "$D$1" Then
Select Case Target.Value
Case "Non validé"
Me.Tab.Color = vbRed
Case "Validé"
Me.Tab.Color = vbGreen
Case "En cours"
Me.Tab.Color = vbBlue
Case "A faire"
Me.Tab.Color = vbYellow
Case "En attente"
Me.Tab.Color = vbOrange
End Select
Next

If Target.Count = 1 Then
If Target.Address(0, 0) = "I17" Then Range("x:ae").EntireColumn.Hidden = UCase(Target) = "X"
End Select
Next
End Sub



Merci à vous
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir JULIATAZ, et bienvenu sur XLD,
Déjà utilisez les balises </> ( à droite de GIF ), c'est plus lisible.
Ensuite essayez d'indenter le code, c'est plus lisible aussi et ça permet de lever les erreurs :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice
    If Target.Address = "$D$1" Then
        Select Case Target.Value
            Case "Non validé"
                Me.Tab.Color = vbRed
            Case "Validé"
                Me.Tab.Color = vbGreen
            Case "En cours"
                Me.Tab.Color = vbBlue
            Case "A faire"
                Me.Tab.Color = vbYellow
            Case "En attente"
                Me.Tab.Color = vbOrange
        End Select
    Next

    If Target.Count = 1 Then
        If Target.Address(0, 0) = "I17" Then Range("x:ae").EntireColumn.Hidden = UCase(Target) = "X"
    End Select
Next
End Sub
On ne voit qu'une macro, je ne sais pas où est la deuxième.
Face au premier IF on trouve un NEXT au lieu d'un ENDIF
Face au second IF on trouve un End Select au lieu d'un EndIF
Il y a un Next à la fin sans For.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice
    If Target.Address = "$D$1" Then
        Select Case Target
            Case "Non validé"
                Me.Tab.Color = vbRed
            Case "Validé"
                Me.Tab.Color = vbGreen
            Case "En cours"
                Me.Tab.Color = vbBlue
            Case "A faire"
                Me.Tab.Color = vbYellow
            Case "En attente"
                Me.Tab.Color = vbOrange
        End Select
    End If
    If Target.Count = 1 Then
        If Target.Address(0, 0) = "I17" Then Range("x:ae").EntireColumn.Hidden = UCase(Target) = "X"
    End If
End Sub
 

JULIATAZ

XLDnaute Nouveau
Bonsoir JULIATAZ, et bienvenu sur XLD,
Déjà utilisez les balises </> ( à droite de GIF ), c'est plus lisible.
Ensuite essayez d'indenter le code, c'est plus lisible aussi et ça permet de lever les erreurs :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice
    If Target.Address = "$D$1" Then
        Select Case Target.Value
            Case "Non validé"
                Me.Tab.Color = vbRed
            Case "Validé"
                Me.Tab.Color = vbGreen
            Case "En cours"
                Me.Tab.Color = vbBlue
            Case "A faire"
                Me.Tab.Color = vbYellow
            Case "En attente"
                Me.Tab.Color = vbOrange
        End Select
    Next

    If Target.Count = 1 Then
        If Target.Address(0, 0) = "I17" Then Range("x:ae").EntireColumn.Hidden = UCase(Target) = "X"
    End Select
Next
End Sub
On ne voit qu'une macro, je ne sais pas où est la deuxième.
Face au premier IF on trouve un NEXT au lieu d'un ENDIF
Face au second IF on trouve un End Select au lieu d'un EndIF
Il y a un Next à la fin sans For.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice
    If Target.Address = "$D$1" Then
        Select Case Target
            Case "Non validé"
                Me.Tab.Color = vbRed
            Case "Validé"
                Me.Tab.Color = vbGreen
            Case "En cours"
                Me.Tab.Color = vbBlue
            Case "A faire"
                Me.Tab.Color = vbYellow
            Case "En attente"
                Me.Tab.Color = vbOrange
        End Select
    End If
    If Target.Count = 1 Then
        If Target.Address(0, 0) = "I17" Then Range("x:ae").EntireColumn.Hidden = UCase(Target) = "X"
    End If
End Sub
Bonjour,
Merci pour votre réponse très claire et pour vos recommandations !
Je me permets de vous demander aussi, si je veux rajouter d'autres codes à la suite (le même que le second mais en masquant d'autres colonnes (ag:ar) en fonction d'une autre cellule (R11), que dois-je écrire ene dessous svp ?
Merci encore
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir,
Il suffit d'ajouter à la suite la condition si c'est R11 qui est sélectionnée :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice
    If Target.Address = "$D$1" Then
        Select Case Target
            Case "Non validé"
                Me.Tab.Color = vbRed
            Case "Validé"
                Me.Tab.Color = vbGreen
            Case "En cours"
                Me.Tab.Color = vbBlue
            Case "A faire"
                Me.Tab.Color = vbYellow
            Case "En attente"
                Me.Tab.Color = vbOrange
        End Select
    End If
    If Target.Count = 1 Then
        If Target.Address(0, 0) = "I17" Then Range("x:ae").EntireColumn.Hidden = UCase(Target) = "X"
    End If
    If Target.Address = "$R$11" Then
        Range("ag:ar").EntireColumn.Hidden = UCase(Target) = "X"    ' à ajuster sur le contenu de R11.
    End If
End Sub
J'ai supposé que le masquage s'effectue sur une valeur précise dans R11.
 

Discussions similaires

  • Résolu(e)
Microsoft 365 pb formule vba
Réponses
15
Affichages
759

Statistiques des forums

Discussions
312 096
Messages
2 085 254
Membres
102 839
dernier inscrit
Tougtoug