XL 2010 Reprise d'une macro sans raison apparente

[sabagof]

Bonjour à tous à toutes,
Merci pour tous vos efforts. Je voudrais savoir où se situe l'erreur. En effet cette macro ci-joint me permet de filtrer un tableau et continuer ensuite son exécution. Malheureusement avec l'exécution pas à pas (avec la touche f8) je constate que sans aller à la fin des lignes elle remonte subitement au début.....
NB le point de retour n'est pas fixe....
Merci de m'éclairer ou de me situer dans mon erreur.


Private Sub Cbx_fourn_resp_Click()
Application.ScreenUpdating = False 'calme l'écran

On Error Resume Next

Sheets("booking").Select
ActiveSheet.Unprotect

Range("b5").Select
Selection.AutoFilter
'
If MsgBox("Voulez-vous tracer le Fournisseur ou le Responsable : " & " " & " " & Me.Cbx_fourn_resp & " " & "?", vbYesNo) = vbYes Then
'
ActiveSheet.ListObjects("Tableau5").Range.AutoFilter Field:=4, Criteria1:=Cbx_fourn_resp
'
NbrLignes = 0
NbrLignes = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
'
If NbrLignes = 0 Then

MsgBox "Aucune ligne à afficher"
'
Else
'
Unload Me
tracabilit 'une autre macro qui marche bien
End If
'
Me.Cbx_fourn_resp.Value = ""
'
ActiveSheet.Select
End If
End Sub

 

[Robert]

Bonjour Sabagof, bonjour le forum,

Difficile sans le fichier de savoir ce qu'il se passe !...
Le On Error Resume Next n'est pas une bonne idée car tu ne gère pas derrière le type d'erreur. Je te propose ton code modifié mais je ne pense pas que ce soit la solution :

Private Sub Cbx_fourn_resp_Click()
Dim O As Worksheet

Application.ScreenUpdating = False 'calme l'écran
Set O = Worksheets("booking")
'On Error Resume Next
O.Unprotect
O.Range("b5").AutoFilter
If MsgBox("Voulez-vous tracer le Fournisseur ou le Responsable : " & " " & " " & Me.Cbx_fourn_resp & " " & "?", vbYesNo) = vbYes Then
    O.ListObjects("Tableau5").Range.AutoFilter Field:=4, Criteria1:=Cbx_fourn_resp
    NbrLignes = O.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
    If NbrLignes = 0 Then
        MsgBox "Aucune ligne à afficher"
    Else
        Unload Me
        tracabilit 'une autre macro qui marche bien
    End If
    Me.Cbx_fourn_resp.Value = ""
    O.Select
End If
End Sub

 

[sabagof]

Bonjour Sabagof, bonjour le forum,

Difficile sans le fichier de savoir ce qu'il se passe !...
Le On Error Resume Next n'est pas une bonne idée car tu ne gère pas derrière le type d'erreur. Je te propose ton code modifié mais je ne pense pas que ce soit la solution :

Private Sub Cbx_fourn_resp_Click()
Dim O As Worksheet

Application.ScreenUpdating = False 'calme l'écran
Set O = Worksheets("booking")
'On Error Resume Next
O.Unprotect
O.Range("b5").AutoFilter
If MsgBox("Voulez-vous tracer le Fournisseur ou le Responsable : " & " " & " " & Me.Cbx_fourn_resp & " " & "?", vbYesNo) = vbYes Then
    O.ListObjects("Tableau5").Range.AutoFilter Field:=4, Criteria1:=Cbx_fourn_resp
    NbrLignes = O.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
    If NbrLignes = 0 Then
        MsgBox "Aucune ligne à afficher"
    Else
        Unload Me
        tracabilit 'une autre macro qui marche bien
    End If
    Me.Cbx_fourn_resp.Value = ""
    O.Select
End If
End Sub

Bonjour et Merci Bcp pour avoir pris en compte ma préoccupation, néanmoins ton code aussi a fait la même chose, c'est dire exécuter les lignes jusqu'à la ligne O.Range("b5").AutoFilter retourne au début ou bien après avoir exécuter If MsgBox("Voulez-vous tracer le Fournisseur ou le Responsable : " & " " & " " & Me.Cbx_fourn_resp , retourne.
A toute fin utile je joins ci après le fichier "booking".
Dans l'attente......

 

[Dranreb]

Bonjour.
Elle ne remonte pas au début, ça n'existe pas..
C'est plutôt un appel récursif intempestif de la même procédure avec tout un jeu de nouvelles variables locales !
Je soupçonne la Me.Cbx_fourn_resp.Value = "" de provoquer ça.

 

[Robert]

Re,

Bien vu Sabagof ! Un fichier avec mot de passe pour voir le code VBA... Je n'y aurais pas pensé...

 

[sabagof]

Re,

Bien vu Sabagof ! Un fichier avec mot de passe pour voir le code VBA... Je n'y aurais pas pensé...

Bonjour et Toutes mes excuses Robert, c'est un oubli de ma part. Veuilles trouver ci-joint le fichier sans mot de passe. Je suis sincèrement désolé.

Le problème se trouve surtout sur le userform "TRACE_usf" principalement le code du cbx_fourn_resp.
Merci.

 

[Dranreb]

Bonjour.
je confirme que c'est bien un appel récursif.
Il peut se neutraliser en mettant au début :

Private Sub Cbx_fourn_resp_Click()
Dim O As Worksheet
Static Récursif As Boolean
If Récursif Then Exit Sub
Récursif = True

Et à la fin :

Récursif = False
End Sub

Récursif pourrait aussi se déclarer en Private Récursif As Boolean en tête du module plutôt qu'en Static dans la procédure.

 

[Dranreb]

Mais je ne comprends pas pourquoi tant de gens continuent à s'écrire des procédures lourdes, utilisant des filtres, alors qu'avec le complément VBA issu de cette ressource c'est si facile à écrire et à mettre au point, surtout si les plages à mettre à jour ont subi une mise sous forme de tableau …
Je suppose que c'est à cause de ses 99% de possibilités qui ne sont qu'assez rarement nécessaires …

 

[sabagof]

Bonjour Robert,
Merci beaucoup pour cet astuce qui me sort de tous mes soucis. çà marche. Je suis conscient de la lourdeur de mes modules.
Merci également pour le lien vers le complément VBA que j'ai déjà téléchargé, installé et commencé la lecture. cela parait simplifié la vie si on s'y met. Je m'y appliquerai. Bonne fin de semaine et à plus.

 

[Dranreb]

Bonjour
Moi, c'est Dranreb, pas Robert.
Toujours à votre disposition pour un coup de main, si nécessaire, pour la mise en œuvre du CLsCAs. Pour la petite histoire, et puisque c'était dans le sujet, sacher que les objets ComboBoxLiées et ControlsAssociés utilisent une Private NePasExécuterChange As Boolean justement pour pouvoir détecter eux aussi qu'un changement des objets dont ils ont la charge a été induit par eux même et non par une intervention extérieure.

 

[Robert]

Dranreb, Robert... Bernard, Trebor... Je comprends qu'on puisse confondre deux prénoms aussi nases .