XL 2021 Codes vba : Worksheet_Change

[achraf26]

Bonjour
j'ai mis 2 code vba sur "Visualiser le code de la meme feuille (Feuil1)
le 1er pour filter
et le 2e pour Afficher et masque des shapes

Sub Worksheet_Change(ByVal Target As Range)

Private Sub Worksheet_Change(ByVal c As Range)

mais j'ai une erreur impossible d'executer les macros, il est possible qu'elle ne soit pas disponible.
une fois je supprime une l'autre fonctionne.

j'ai cherché un peu je trouve qu'il y'a des modules mais je ne sais meme pas à quoi sert, ou peut etre je dois les séparer.
Merci à vous

 

[sylvanu]

Bonjour Achraf,
Un petit fichier test serait le bienvenu.
Ces deux macros sont elles sur la même feuille ?
Si oui, on ne peut pas avoir deux Worksheet_Change sur une même feuille.
On peut traiter deux actions dans une même Worksheet_Change, mais pour cela, il faut connaitre votre code et vos contraintes.

 

[achraf26]

Bonjour,
une fois je rajoute ce code, pour filtrer, tout bascule

Private Sub Worksheet_Change(ByVal c As Range)
    If c.Address = "$B$5" Then
        Select Case c
        Case "": ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=3
        Case Else: ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=3, Criteria1:=c
        End Select
    End If
     If c.Address = "$B$6" Then
        Select Case c
        Case "": ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=12
        Case Else: ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=12, Criteria1:=c
        End Select
    End If
    If c.Address = "$D$6" Then
        Select Case c
        Case "": ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=7
        Case Else: ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=7, Criteria1:=c
        End Select
        [B8].Select
    End If
End Sub

 

[sylvanu]

Re,

on ne peut pas avoir deux Worksheet_Change sur une même feuille.

Donc en PJ j'ai concaténer les deux Worksheet_Change en une seule.

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [B5]) Is Nothing Then
        ValB5 = [B5] ' Evite de lire 7 fois B5
        ActiveSheet.Shapes("Connecteur 1").Visible = ValB5 = "F"
        ActiveSheet.Shapes("Connecteur 2").Visible = ValB5 = "R"
        ActiveSheet.Shapes("Connecteur 3").Visible = ValB5 = "E"
        ActiveSheet.Shapes("Connecteur 4").Visible = ValB5 = "O"
        ActiveSheet.Shapes("Rectangle 13").Visible = ValB5 = "F"
        ActiveSheet.Shapes("Rectangle 14").Visible = ValB5 = "O"
        ActiveSheet.Shapes("Rectangle 15").Visible = ValB5 = "E"
    End If
    If Target.Address = "$B$5" Then
        Select Case Target
            Case "": ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=3
            Case Else: ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=3, Criteria1:=Target
        End Select
    ElseIf Target.Address = "$B$6" Then
        Select Case Target
            Case "": ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=12
            Case Else: ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=12, Criteria1:=Target
        End Select
    ElseIf Target.Address = "$D$6" Then
        Select Case Target
            Case "": ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=7
            Case Else: ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=7, Criteria1:=Target
        End Select
        [B8].Select
    End If
Fin:
Application.ScreenUpdating = True
End Sub

En espérant ne pas mettre planter dans les actions à mener.

 

[sylvanu]

Bonjour Achraf,
Alors, ça a marché ou avez vous jeté l'éponge ?
C'est toujours sympa de connaitre le résultat, positif ou négatif.

 

[achraf26]

Bonjour Achraf,
Alors, ça a marché ou avez vous jeté l'éponge ?
C'est toujours sympa de connaitre le résultat, positif ou négatif.

Bonjour Sylavnu,
je n'étais pas connecté, j'ai bien pris le code ca fonctionne super bien.
Un grand merci.