Sub CacherAfficherLignes()
'Vérifier que la macro n'a pas été appelée par une méthode non autorisée:
' Outils/Macro ou Alt+F
'Application.Caller doit contenir une valeur chaine de caractère
'normalement est le nom de la case à cocher
'qui a déclenché la macro
If VarType(Application.Caller) <> vbString Then GoTo ErreurObjet
'Déclaration des variables
Dim oCheckBox As Object 'Case à cocher ayant été cliquée
Dim c As Range 'Cellule à trouver (colonne à gauche des tableaux, première ligne)
Dim OuiNon As Boolean ' La case à cocher est cochée ou non
'Si erreur on passe à la ligne suivante
On Error Resume Next
'On essaie de référencer la case à cocher par son nom sur la feuille 1
'application.caller= normalement le nom de la case à cocher
Set oCheckBox = Sheets("feuille 1").Shapes(Application.Caller).DrawingObject
'Si une erreur s'est produite on va à la ligne ErreurObjet
If Err.Number > 0 Then GoTo ErreurObjet
'Récupérer la cellule liée de la case à cocher
Set c = Range(oCheckBox.LinkedCell)
'Si une erreur s'est levée: problème->aller à erreurCellule
On Error GoTo ErreurCellule
'Si la cellule n'est pas de type logique(Vrai/faux) ->aller à ErreurTypeValeur
If VarType(c.Value) <> vbBoolean Then GoTo ErreurTypeValeur
'Pour la suite si on rencontre une erreur aller à AutreErreur
On Error GoTo AutreErreur
'OuiNon récupère la valeur de la cellule liée
OuiNon = c.Value
'On décale la cellule de 0 ligne et 1 colonne
Set c = c.Offset(, 1)
'Boucler tant que la cellule (c) n'est pas vide
Do While Not IsEmpty(c)
'Cacher la ligne entière suivant la valeur que contient OuiNon
c.EntireRow.Hidden = Not OuiNon
'Décaler la cellule d'une ligne
Set c = c.Offset(1)
Loop
'On a rencontré une cellule vide (fin du tableau) on sort
Exit Sub
'Gestion des erreurs
ErreurCellule:
MsgBox "Le tableau correspondant en feuille 2 n'a pas été trouvé!" & vbCrLf & "Vérifiez la cellule liée de la case à cocher", vbExclamation, "CacherAfficherLignes"
Exit Sub 'sortir
'La valeur de la celllule liée n'est pas une valeur logique
ErreurTypeValeur:
MsgBox "La cellule liée à " & oCheckBox.Name & " comporte autre chose que Vrai ou Faux!", vbExclamation, "CacherAfficherLigne"
Exit Sub 'sortir
'La case à cocher n'a pas été initialisée
'ou on a appelé la macro à partir d'un autre objet
ErreurObjet:
MsgBox "Cette macro ne peut être appelée que sur action d'une case à cocher!", vbExclamation, "CacherAfficherLigne"
Exit Sub 'sortir
'Afficher les autres erreurs avec les descriptions par défaut.
AutreErreur:
MsgBox "Erreur: " & Err.Number & vbCrLf & vbdescription, vbExclamation, "AfficherCacherLignes"
'Fin de macro
End Sub
