Améliorer macro boucle jusqu'a ligne vide

bonjour à tous,

Voici une macro me permettant d'afficher cacher une partie de lignes d'une feuille selon qu'une case à cocher correspondante soit ou non selectionné. Il effectue une boucle jusqu'à ce qu'une ligne soit vide puis s'arrette. et cela pour afficher/masquer entre le départ et la ligne vide.

cela fonctionne à merveille, mais je voudrais une amélioration, car ce procédé à quelques inconvéniant :

• obligation de remplir chaque ligne jusqu'à la fin sous peine de n'afficher qu'une partie voulue en cas d'oubli
• latence de quelques secondes pour executer cette macro et cela pour parfois juste une dizaine de ligne.

est'il possible de boucler sur un texte type "stop@stop" plutot que sur une ligne vide comme dans la macro ?

est'il possible de réduire cette latence ?

merci d'avance.

Sub cacheraffichertableauxMBC()

If VarType(Application.Caller) <> vbString Then GoTo ErreurObjet

Dim oCheckBox As Object

Dim c As Range

Dim OuiNon As Boolean

On Error Resume Next

Set oCheckBox = Sheets("base de donnée reservation").Shapes(Application.Caller).DrawingObject

If Err.Number > 0 Then GoTo ErreurObjet

Err.Clear

Set c = Range(oCheckBox.LinkedCell)

On Error GoTo ErreurCellule

If VarType(c.Value) <> vbBoolean Then GoTo ErreurTypeValeur

On Error GoTo AutreErreur

OuiNon = c.Value

Set c = c.Offset(, 1)

Do While Not IsEmpty(c)

c.EntireRow.Hidden = Not OuiNon

Set c = c.Offset(1)

Loop

Exit Sub

ErreurCellule:

MsgBox "Le tableau correspondant n'a pas été trouvé!" & vbCrLf & "Vérifiez la cellule liée de la case à cocher", vbExclamation, "CacherAfficherTableauxMBC"

Exit Sub

ErreurTypeValeur:

MsgBox "La cellule liée à " & oCheckBox.Name & " comporte autre chose que Vrai ou Faux!", vbExclamation, "CacherAfficherTableauxMBC"

Exit Sub

AutreErreur:

MsgBox "Erreur: " & Err.Number & vbCrLf & vbdescription, vbExclamation, "CacherAfficherTableauxMBC"

Exit Sub

ErreurObjet:

MsgBox "Cette macro ne peut être appelée que sur action d'une case à cocher!", vbExclamation, "CacherAfficherTableauxMBC"

End Sub

Bonsoir,

Peux-tu joindre le fichier ?

pas besoin de toutes les lignes, mais sa structure réelle.

avec la macro

Amicalement

Claude

j'ai joint le fichier en PJ

Feuil1 base de donnée à cocher

Feuil2 descriptif affiché ou cahé selon case à cocher de la Feuil1 correspondante

remarque : j'ai mis qu'une reference pour ne pas alourdir, cependant, je n'ai plus ma latence d'execution bizarre !!

ça y est, j'ai trouvé, c'était pas compliqué, je vais tester et esperer ne pas retrouver de latence, mais là j'ai un doute !!

Sub cacheraffichertableauxMBC()

If VarType(Application.Caller) <> vbString Then GoTo ErreurObjet

Dim oCheckBox As Object

Dim c As Range

Dim OuiNon As Boolean

On Error Resume Next

Set oCheckBox = Sheets("base de donnée reservation").Shapes(Application.Caller).DrawingObject

If Err.Number > 0 Then GoTo ErreurObjet

Err.Clear

Set c = Range(oCheckBox.LinkedCell)

On Error GoTo ErreurCellule

If VarType(c.Value) <> vbBoolean Then GoTo ErreurTypeValeur

On Error GoTo AutreErreur

OuiNon = c.Value

Set c = c.Offset(, 1)

Do While Not (c) = "stop-stop"

c.EntireRow.Hidden = Not OuiNon

Set c = c.Offset(1)

Loop

Exit Sub

ErreurCellule:

MsgBox "Le tableau correspondant n'a pas été trouvé!" & vbCrLf & "Vérifiez la cellule liée de la case à cocher", vbExclamation, "CacherAfficherTableauxMBC"

Exit Sub

ErreurTypeValeur:

MsgBox "La cellule liée à " & oCheckBox.Name & " comporte autre chose que Vrai ou Faux!", vbExclamation, "CacherAfficherTableauxMBC"

Exit Sub

AutreErreur:

MsgBox "Erreur: " & Err.Number & vbCrLf & vbdescription, vbExclamation, "CacherAfficherTableauxMBC"

Exit Sub

ErreurObjet:

MsgBox "Cette macro ne peut être appelée que sur action d'une case à cocher!", vbExclamation, "CacherAfficherTableauxMBC"

End Sub