Probleme avec une Worksheet Résolu

Question

Bonsoir à tous,

J'ai un souci avec une procédure Worksheet sur laquelle j'ai passé une bonne partie de l'AM sans trouver la solution. J'espère que quelqu'un pourra m'aider.
Dans cette procédure, après une première partie qui est commune je traite 3 cas différents avec une instruction " Select Case ". Le 1er et 3iem cas fonction parfaitement, seul le 2iem cas me pose problème. Petite précision je teste les mêmes conditions dans les deux premiers "CaseV, la différence réside dans la façon de repositionner la cellule active à la fin de chaque instruction "IF ".
Quand je passe dans "Case 31 To 39"  deux cas :
- Si je passe en premier dans le second "IF" (Adhérent non à jour), c'est bon.
- Si je passe dans le premier "IF " j'effectue bien ce qui est écrit mais quand Je clic sur le bouton Ok de la boîte de dialogue j'ai un message d'erreur « Erreur d'exécution "13". Incompatibilité de type » sur la première ligne du deuxième "IF" : If Cells(sel.Row, 21).Value = 0 Then. Je ne comprends pas...
Toute la procédure est ci-dessous.
Merci d'avance pour votre aide car après plusieurs heures...
Cordialement
Mistral


Private Sub Worksheet_Change(ByVal sel As Range)

' Surveille si une saisie a lieu sur la colonne "D" et a partir de la ligne 28.
If sel.Column = 4 And sel.Row > 27 Then
Dim cel As Range, rien As Boolean
    rien = False
    For Each cel In sel.Cells
        If cel.Value = "" Then
        ActiveSheet.Unprotect ("")
            cel.Offset(0, 5).Value = ""
        ActiveSheet.Protect ("")
            rien = True
        End If
    Next cel
    If rien Then Exit Sub
    If sel.Count > 1 Then Exit Sub
    
' Surveille le nombre de maximum de X par auteur (Maxi = le Nb max). (Fonctionnement OK)
 If sel.Value = False Then sel.Value = "": Exit Sub
    If Application.WorksheetFunction.CountIf(Range("D:D"), sel.Value) > [maxi].Value Then
            MsgBox ("Le nombre de X autorisé pour cet auteur" & vbCr & "est déjà atteint."), vbCritical, "Fédération  de France"
            sel.Value = ""
            sel.Select
            Exit Sub
    End If

    Select Case [Num_Compet]
    Case 11 To 29, 51 To 69     ' Traitement des X.

' Surveille si une cellule de la colonne " P " contient un N° d'un non adhérent F.X.F".
    If Cells(sel.Row, 16).Value = "Numéro d'adhérent inconnu..." Then
        MsgBox "Cet auteur n'est pas adhérent de la F.X.F!" & Chr(10) & _
            " " & Chr(10) & _
            "Il ne peut donc pas participer à cette compétition!" & Chr(10) & _
            " " & Chr(10) & _
            "Désolé..." & Chr(10) & _
            " ", vbCritical, "Fédération  X de France"
        sel.Value = ""
        sel.Select
        Exit Sub
    End If
    
' Surveille si une cellule de la colonne "U" contient un adhérent non à jour de sa cotisation. (Fonctionnement correct).
    If Cells(sel.Row, 21).Value = 0 Then
        MsgBox "Cet auteur n'est pas à jour de sa cotisation F.X.F!" & Chr(10) & _
            " " & Chr(10) & _
            "Il ne peut donc pas participer à cette compétition!" & Chr(10) & _
            " " & Chr(10) & _
            "Désolé..." & Chr(10) & _
            " ", vbCritical, "Fédération  de France"
        sel.Value = ""
        sel.Select
        Exit Sub
    End If

    Case 31 To 39               ' Traitement du X.
'Surveille si une cellule de la colonne "P" contient "Numéro d'adhérent inconnu".
    If Cells(sel.Row, 16).Value = "Numéro d'adhérent inconnu..." Then
        MsgBox "Cet auteur n'est pas adhérent de la F.X.F!" & Chr(10) & _
            " " & Chr(10) & _
            "Il ne peut donc pas participer à cette compétition!" & Chr(10) & _
            " " & Chr(10) & _
            "Désolé..." & Chr(10) & _
            " ", vbCritical, "Fédération  X de France"
            sel.Value = ""
            sel.Offset(0, -1).Value = ""
            sel.Offset(0, -1).Select
    Else
            sel.Offset(1, -1).Select
    End If
    
'Surveille si une cellule de la colonne "U" contient un adhérent non à jour de sa cotisation.
    If Cells(sel.Row, 21).Value = 0 Then
        MsgBox "Cet auteur n'est pas à jour de sa cotisation F.X.F!" & Chr(10) & _
            " " & Chr(10) & _
            "Il ne peut donc pas participer à cette compétition!" & Chr(10) & _
            " " & Chr(10) & _
            "Désolé..." & Chr(10) & _
            " ", vbCritical, "Fédération  X de France"
            sel.Value = ""
            sel.Offset(0, -1).Value = ""
            sel.Offset(0, -1).Select
    Else
            sel.Offset(1, -1).Select
    End If

    Case 41 To 49                   ' Traitement du X.
'Surveille si une cellule de la colonne " P " contient "Numéro d'adhérent inconnu".
    If Cells(sel.Row, 16).Value = "Numéro d'adhérent inconnu..." Then
'Surveille la validité du N° d'un non adhérent : > 9000 et numérique
        If sel.Value < 9000 Or Not IsNumeric(sel.Value) Then
        MsgBox ("Pour un auteur sans X vous devez" & vbCr & "obligatoirement saisir un N° > à 9000."), vbInformation, "Fédération  X de France"
            sel.Value = Application.InputBox("Saisissez un numéro > 9000." & vbCr & vbCr & "Validation par OK.", "Numéro d'un non ahérent.", , 300, 140, Type:=1)
            Exit Sub
        End If
'Déclaration des variables
        Dim nom As Variant
        Dim pnom As Variant
'Ouverture de la boite pour saisir le nom et contrôle.
        nom = Application.InputBox("Saisissez le Nom." & vbCr & vbCr & "Validation par OK.", "Nom d'un non adhérent.", , 300, 140)
        If nom = False Then
            sel.Value = ""
            sel.Select
            Exit Sub                'Vérifie si la toucher Annuler est active.
        End If
'Ouverture de la boite pour saisir le prénom et contrôle.
        pnom = Application.InputBox("Saisissez le prénom." & vbCr & vbCr & "Validation par OK.", "Prénom d'un non adhérent.", , 300, 140)
        If pnom = False Then
            sel.Value = ""
            sel.Select
            Exit Sub                'Vérifie si la toucher Annuler est active.
        End If
'Mise au format nom propre (1er lettre en majuscule).
        nom = UCase(Left(nom, 1)) & Mid(nom, 2)
        pnom = UCase(Left(pnom, 1)) & Mid(pnom, 2)
' Remplacement du contenu de la cellule en erreur.
        ActiveSheet.Unprotect ("")
Cells(sel.Row, 9).Value = nom & " " & pnom
         ActiveSheet.Protect ("")
    End If
    sel.Offset(1, 0).Select

End Select
End If
End Sub

eriiic · Answer

Bonsoir,

1) tu peux mettre en forme le code en le sélectionnant et en lui appliquant la balise code (voir les icone au-dessus de ton texte édité).
Ca sera plus lisible...
2) tu peux déposer un fichier exemple sur cijoint.fr et coller le lien fourni
3) donner les conditions initiales et les actions à faire pour reproduire le problème.

Ceci dit tu fais appel à worksheet_change et tu modifies des cellules, ce qui rappelle à nouveau ta procédure.
Est-ce voulu ?
Sinon en début de code tu peux mettre application.enableevents=false, à rétablir avec =true avant de quitter la procédure

eric

Mistral_13200 · Answer

Bonjour Eric,
Tout d'abord merci de t'intéresser à mon problème.
Ci-dessous j'ai annoté ton message avec quelques précision qui j'espère te seront utiles. Je remets la procédure à la fin avec l'utilisation des balises.
J'espère que tu trouveras une solution car c'est mon problème essentiel.
Encore merci à toi.
Cordialement
Mistral

Bonsoir, 
1) Tu peux mettre en forme le code en le sélectionnant et en lui appliquant la balise code (voir les icône au-dessus de ton texte édité). Ca sera plus lisible...
Ok je te fais ça.
2) Tu peux déposer un fichier exemple sur cijoint.fr et coller le lien fourni.
Très difficile car cela m'oblige à aseptiser mon classeur qui contient une base de donnée de plus de 6000 lignes sans laquelle il ne fonctionne pas. Mais si c'est absolument nécessaire je referais un classeur exemple mais il me faudra du temps.
3) Donner les conditions initiales et les actions à faire pour reproduire le problème. 
En fonction de la valeur de la cellule nommée "Num_Compet" je passe dans l'une ou l'autre branche "Case" chaque fois qu'une saisie est effectuée dans une des cellules de la colonne "D". Le troisième "Case" fonctionne parfaitement. Les deux premiers effectuent exactement les mêmes contrôles. La différence réside dans la façon de repositionner la cellule active à la fin de chaque "IF". Mon problème se situe dans le second "Case" avec l'erreur décrite dans mon message d'hier.
Ceci dit tu fais appel à worksheet_change et tu modifies des cellules, ce qui rappelle à nouveau ta procédure. Est-ce voulu ?
Oui je surveille toutes les saisies effectuées dans la colonne "D".
Sinon en début de code tu peux mettre application.enableevents=false, à rétablir avec =true avant de quitter la procédure 
Eric

La procedure avec la balise code.

Private Sub Worksheet_Change(ByVal sel As Range)

' Surveille si une saisie a lieu sur la colonne "D" et a partir de la ligne 28.
If sel.Column = 4 And sel.Row > 27 Then
Dim cel As Range, rien As Boolean
    rien = False
    For Each cel In sel.Cells
        If cel.Value = "" Then
        ActiveSheet.Unprotect ("")
            cel.Offset(0, 5).Value = ""
        ActiveSheet.Protect ("")
            rien = True
        End If
    Next cel
    If rien Then Exit Sub
    If sel.Count > 1 Then Exit Sub
    
' Surveille le nombre de maximum de X par auteur (Maxi = le Nb max). (Fonctionnement OK)
 If sel.Value = False Then sel.Value = "": Exit Sub
    If Application.WorksheetFunction.CountIf(Range("D:D"), sel.Value) > [maxi].Value Then
            MsgBox ("Le nombre de X autorisé pour cet auteur" & vbCr & "est déjà atteint."), vbCritical, "Fédération  de France"
            sel.Value = ""
            sel.Select
            Exit Sub
    End If

    Select Case [Num_Compet]
    Case 11 To 29, 51 To 69     ' Traitement des X.

' Surveille si une cellule de la colonne " P " contient un N° d'un non adhérent F.X.F".
    If Cells(sel.Row, 16).Value = "Numéro d'adhérent inconnu..." Then
        MsgBox "Cet auteur n'est pas adhérent de la F.X.F!" & Chr(10) & _
            " " & Chr(10) & _
            "Il ne peut donc pas participer à cette compétition!" & Chr(10) & _
            " " & Chr(10) & _
            "Désolé..." & Chr(10) & _
            " ", vbCritical, "Fédération  X de France"
        sel.Value = ""
        sel.Select
        Exit Sub
    End If
    
' Surveille si une cellule de la colonne "U" contient un adhérent non à jour de sa cotisation. (Fonctionnement correct).
    If Cells(sel.Row, 21).Value = 0 Then
        MsgBox "Cet auteur n'est pas à jour de sa cotisation F.X.F!" & Chr(10) & _
            " " & Chr(10) & _
            "Il ne peut donc pas participer à cette compétition!" & Chr(10) & _
            " " & Chr(10) & _
            "Désolé..." & Chr(10) & _
            " ", vbCritical, "Fédération  de France"
        sel.Value = ""
        sel.Select
        Exit Sub
    End If

    Case 31 To 39               ' Traitement du X.
'Surveille si une cellule de la colonne "P" contient "Numéro d'adhérent inconnu".
    If Cells(sel.Row, 16).Value = "Numéro d'adhérent inconnu..." Then
        MsgBox "Cet auteur n'est pas adhérent de la F.X.F!" & Chr(10) & _
            " " & Chr(10) & _
            "Il ne peut donc pas participer à cette compétition!" & Chr(10) & _
            " " & Chr(10) & _
            "Désolé..." & Chr(10) & _
            " ", vbCritical, "Fédération  X de France"
            sel.Value = ""
            sel.Offset(0, -1).Value = ""
            sel.Offset(0, -1).Select
    Else
            sel.Offset(1, -1).Select
    End If
    
'Surveille si une cellule de la colonne "U" contient un adhérent non à jour de sa cotisation.
    If Cells(sel.Row, 21).Value = 0 Then
        MsgBox "Cet auteur n'est pas à jour de sa cotisation F.X.F!" & Chr(10) & _
            " " & Chr(10) & _
            "Il ne peut donc pas participer à cette compétition!" & Chr(10) & _
            " " & Chr(10) & _
            "Désolé..." & Chr(10) & _
            " ", vbCritical, "Fédération  X de France"
            sel.Value = ""
            sel.Offset(0, -1).Value = ""
            sel.Offset(0, -1).Select
    Else
            sel.Offset(1, -1).Select
    End If

    Case 41 To 49                   ' Traitement du X.
'Surveille si une cellule de la colonne " P " contient "Numéro d'adhérent inconnu".
    If Cells(sel.Row, 16).Value = "Numéro d'adhérent inconnu..." Then
'Surveille la validité du N° d'un non adhérent : > 9000 et numérique
        If sel.Value < 9000 Or Not IsNumeric(sel.Value) Then
        MsgBox ("Pour un auteur sans X vous devez" & vbCr & "obligatoirement saisir un N° > à 9000."), vbInformation, "Fédération  X de France"
            sel.Value = Application.InputBox("Saisissez un numéro > 9000." & vbCr & vbCr & "Validation par OK.", "Numéro d'un non ahérent.", , 300, 140, Type:=1)
            Exit Sub
        End If
'Déclaration des variables
        Dim nom As Variant
        Dim pnom As Variant
'Ouverture de la boite pour saisir le nom et contrôle.
        nom = Application.InputBox("Saisissez le Nom." & vbCr & vbCr & "Validation par OK.", "Nom d'un non adhérent.", , 300, 140)
        If nom = False Then
            sel.Value = ""
            sel.Select
            Exit Sub                'Vérifie si la toucher Annuler est active.
        End If
'Ouverture de la boite pour saisir le prénom et contrôle.
        pnom = Application.InputBox("Saisissez le prénom." & vbCr & vbCr & "Validation par OK.", "Prénom d'un non adhérent.", , 300, 140)
        If pnom = False Then
            sel.Value = ""
            sel.Select
            Exit Sub                'Vérifie si la toucher Annuler est active.
        End If
'Mise au format nom propre (1er lettre en majuscule).
        nom = UCase(Left(nom, 1)) & Mid(nom, 2)
        pnom = UCase(Left(pnom, 1)) & Mid(pnom, 2)
' Remplacement du contenu de la cellule en erreur.
        ActiveSheet.Unprotect ("")
Cells(sel.Row, 9).Value = nom & " " & pnom
         ActiveSheet.Protect ("")
    End If
    sel.Offset(1, 0).Select

End Select
End If
End Sub

Mistral_13200 · Answer

Re,

Je suis en train de préparer une feuille simplifiée pour que tu puisse juger par toi même. Je demande juste un peu de temps pour purger le classeur de tou le reste.
Je ne suis pas un super spécialiste du VBA et je te demande un peu d'indulgence. Sel.Value=""  est dans la partie commune de la procédure et elle fonctionne parfaitement dans les deux autres cas...
Dès que j'ai terminé mon classuer test je te l'envois.
Mistral

Mistral_13200 · Answer

Re,

Comme promis ce matin voici un fichier test avec un tout petit bout de mon classeur. Il reproduit exactement ce que je fais dans l'original. J'ai mis quelques explications qui j'espère seront suffisantes. Si ce n'est pas le cas n'hésite pas à me poser tes questions. Je ne devrait pas quitter l'ordi de l'AM.

http://www.cijoint.fr/cjlink.php?file=cj201010/cijHmJ2WxJ.xls

Encore un grand merci à toi pour ta disponibilité et ton aide.
Cordialement
Mistral

eriiic · Answer

Re,

A la ligne en erreur tu fais référence à U21 qui a une valeur d'erreur : #REF.
La formule étant : =SI(ET(#REF!>=$S28;#REF!<=$T28);"1";"0"), il faut rétablir cette formule...
Au passage tu aurais du protéger la feuille sans mot de passe ou bien le fournir (qu'on ait pas besoin de le faire sauter). 

Pour le passage en nom propre il faudrait passer en minuscule la fin :
Nom = UCase(Left(Nom, 1)) & LCase(Mid(Nom, 2))
ou plus court :
Nom = Application.Proper(Nom)
(non testé mais ça devrait le faire...)

eric

Mistral_13200 · Answer

Re,

Toutes mes excuses, la cellule de référence à disparue quand j'ai rentré le texte d'explication sur la feuille. C'est réparé et le lien et ci-dessus.

http://www.cijoint.fr/cjlink.php?file=cj201010/cijS4AL8jT.xls

Pour le PW il est sur la feuille.
Cordialement
Mistral

Mistral_13200 · Answer

Je suis sincerment désolé et je te prie de bien vouloir m'excuser.
J'ai vérifié tu ne devrais plus être embété. Ci-dessous un nvx lien.

http://www.cijoint.fr/cjlink.php?file=cj201010/cijCUSPfYP.xls

Mistral

Mistral_13200 · Answer

Normal, tu es sur le concours 41 et là ça marche tout comme sur le 11.
Parcontre c'est avec le concours 31 qu'il y a un problème.

eriiic · Answer

#VALEUR! en U de la ligne en cours.
Par ailleurs C est verrouillée, ça gène aussi...

Et tu devrais apprendre le pas à pas et les espions.
Met un point d'arret en cliquant dans la marge (grise) de la ligne où tu veux que la macro s'arrete.
Par exemple au début sur If sel.Column = 4 And sel.Row > 27 Then et un autre là où tu sais que ça plante, après le case 31 to 39 sur If Cells(sel.Row, 16).Value = "Numéro d'adhérent inconnu..." Then

Fais ta saisie, la macro va s'arreter sur le 1er point d'arret.
avec F5 tu la relances jusqu'au point arret suivant.
Ici avec des F8 successifs tu vas avancer pas à pas et tu pourras contrôler les valeurs des variables et des cellules.

Si tu n'as pas la fenetre espion tu l'affiches dans le menu 'affichage'

Pour contrôler une variable tu la sélectionnes dans ton code et tu la fais glisser dans la fenetre espion, tu pourras y lire sa valeur.
Tu peux y mettre aussi une expression comme Cells(sel.Row, 16).Value
Et la modifier dans la fenetre espion en remplaçant .value par .address pour contrôler si la référence est exacte par exemple.
Quand tu seras habitué à cette partie tu verras qu'on peux aussi faire un point d'arret sur une expression espionne, par exemple sur i=5213

eric

Mistral_13200 · Answer

Tu as totalement raison il faut que j'apprene a faire tout ce que tu dis. Je le fait dans les procédure SUb avec la touche F8 mais ça ne fonctionne pas avec une worksheet et mettre des point d'arret je n'ai jamais fait. Il faut que je m'y mette
mais pour le moment je suis dans l'urgence et j'aimerais savoir si tu as vu quelque chose d'anormal et si oui comment le corriger. J'ai une réunion mardi ou je dois présenter ce classeur. Merci de bien vouloir m'aider.
La colonne C est déverouillée pour le concours 31, celui là même qui pose problème.
Le fonctionnement de la colonne U est le même pour les trois concours, je ne pense pas que ça vienne de là.
Les fonctions qui sont sur cette feuille sont les mêmes pour tous les concours.
Je te l'ai dit tout à l'heure je suis loin d'être une lumière en VBA alors j'appricirais beaucoup su tu pouvais me proposer une solution.
D'avance merci
Mistral

Mistral_13200 · Answer

Bonjour Eric,

J'ai suivi tes conseils, et même si je suis loin de tout comprendre, je me suis rendu compte que le fonctionnement de la Worksheet est loin d'être celui que je pensé. J'ai mis des point d'arrêt et ouvert la fenêtre espion et je me suis rendu compte que je passé dans cette procédure beaucoup plus souvent que je ne le croyais.
Cette procédure m'a été écrite par une personne de CCM et comme elle répondait à ce que je cherchais, j'étais content... A l'époque j'avais trois feuilles bordereaux et chacune avait sa Worksheet et tout se passé bien et sans erreur.
J'ai modifié mon classeur pour n'avoir qu'une seule feuille bordereau et j'ai donc essayé d'adapter la Worksheet pour tenir compte des différents cas et c'est là que mes ennuis commencent.

J'ai modifié mon classeur test concernant la colonne U :
- Adhérent non a jour les colonne Q et U on pour valeur « 0 » et ça fonctionne comme voulu.
- N° inconnu la colonne P est égale à «Numéro d'adhérent inconnu... », la colonne Q est égal à «1 »  et la colonne U est égale « 0 » et le plante toujours sur la même ligne...

Ce que je n'arrive pas à comprendre, malgré les points d'arrêts, c'est pourquoi, dans le cas du concours 31 : 
- Si je test un adhérent non à jour je passe directement et sans problème sur la ligne : If Cells(sel.Row, 21).Value = 0 Then.
- Et quand je test un N° inconnu je passe d'abord sur le premier IF et qu'à la sortie je bloque sur cette même ligne If Cells(sel.Row, 21).Value = 0 Then.

J'ai modifié le Case 31 to 39 pour faire en sorte d'avoir exactement le même traitement que pour le Case 11 to 19 et là ça marche. En fait cela revient à supprimer le repositionnement de la cellule active et l'effacement des cellules des colonne C et D.
Ci-dessous un lien vers le classeur test modifié.

http://www.cijoint.fr/cjlink.php?file=cj201010/cijazmCgYF.xls

Je continu à chercher de mon côté, avec mes faibles moyens, mais pourrais-tu m'aider car je dois présenter ce classeur demain à Paris.
D'avance merci
Mistral

Mistral_13200 · Answer

Re

Je crois avoir compris pourquoi ça ne marche pas!
J'exécute une fois de trop la Worksheet alors que la cellule U de la ligne courante est déjà revenue à une valeur égal à : #VALEUR.
J'ai fait l'essai de forcer cette valeur à 1 juste avant le dernier passage et ça marche.
Mais la encore je ne vois pas comment m'en sortir.
Mistral

Mistral_13200 · Answer

Re,

Ca y est j'y suis arrivé!!! Je n'y croyais plus.
En fait dans le Case 31 to 39 et à la fin de chaque instruction IF j'ai rajouté Exit Sub et ça marche!
Maintenant es-ce le moyen le mieux adapté?
En tout cas un grand merci à toi car sans les pistes que tu m'as ouvertes et la découverte des points d'arrêt je n'y serais pas arrivé.
Il y en a toujours plus dans deux têtes que dans une, surtout la mienne qui est toute petite...
Cordialement.
Mistral

Mistral_13200 · Answer

Re,
Si ça marche autant laisser comme ça pour demain mais une méthode de correction empirique risque de t'amener d'autres ennuis plus tard.
Sûr que pour demain je le laisse comme ça ! C'est d'autant plus vrai que j'ai eu un autre problème, suite à ma modification, que j'ai réglé de suite.

Quand je lis je me suis rendu compte que je passé dans cette procédure beaucoup plus souvent que je ne le croyais Je repense à mon post 1. Ceci dit tu fais appel à worksheet_change et tu modifies des cellules, ce qui rappelle à nouveau ta procédure. Est-ce voulu ?
Tu as raison concernant ton premier post d'hier, mais je n'avais pas vraiment percuté. Non ce n'était pas vraiment ce fonctionnement là que je souhaitais, mais jusqu'à hier je croyais surveiller les saisies dans la colonne D. C'était d'ailleurs l'idée au départ, surveiller la saisie dans une des cellules de la colonne D uniquement. Aujourd'hui je me dis que je pourrais toujours surveiller la même colonne mais entre les lignes 28 à 228 car je n'aurais pas plus de 200 lignes sur le bordereau. A voir.

Sinon en début de code tu peux mettre application.enableevents=false, à rétablir avec =true avant de quitter la procédure. Sur une autre version teste en mettant le enableevents=false dès que tu as passé les tests qui t'exclus de la macro, sans oublier de remettre à true à chaque sortie possible.

Je vais étudier cette possibilité dès que possible. Regarder ce qu'elle fait réellement, la comprendre pour savoir où exactement la placer. Je vais attendre aussi les résultats de la présentation de demain au cas ou d'autres modifications me tomberaient dessus.

En tout cas un grand merci à toi car sans tes conseils avisés je n'y serais probablement pas arrivé et si tu le permets je reviendrais vers toi en cas de souci, ou incompréhension de ma part.
Cordialement
Mistral

Mistral_13200 · Answer

Bonsoir Eric,

Si je reviens vers toi aujourd'hui c'est pour admettre mon incapacité à résoudre mon problème. Et pourtant, crois moi, j'y ai mis de la bonne volonté! J'y ai passé la journée d'hier et une bonne partie de la nuit.
Ma présentation c'est globalement bien passée malgré un plantage du classeur preuve qui l'est loin d être parfait. De plus mes craintes se sont révélées exactes puisqu'on m'a demandé un contrôle supplémentaire. J'ai vainement essayé de mettre en oeuvre tes conseils :
- J'ai modifié le fonction des cellules de Q à U (pour éviter les #VALEUR) et c'est modification on changé le fonctionnement de la procédure. Pourquoi ?
- J'ai essayé de mettre en place application.enableevents=false mais sans résultats car je n'ai pas compris comment l'utiliser.
Alors ma demande vas être directe, pourrais-tu, s'il te plait, si tu as le temps et l'envie, soit corriger l'existant soit réécrire la worksheet. Choisi le plus simple et le plus rapide pour toi. Ci-dessous un lien vers le fichier.

http://www.cijoint.fr/cjlink.php?file=cj201010/cijpyMxaUp.xls

Dans le cas où tu accepterais, voilà ci-dessous plus en détail comment elle devrait fonctionner :
- Pour les concours 11 et 41, il ne faut saisir que le N° carte (colonne D).
- Pour les concours 11 et 41 les N° d'UR et de club seront affichés automatiquement, après la saisi du N° de Carte.
- Pour le concours 31 il faut saisir le N° de club et de carte (colonne C et D).
- Pour les concours 31 le N° d'UR est affiché automatiquement, après la saisi du N° de Carte.
- Colonne F on a le N° complet de l'adhérent ce numéro est au format texte et il est réalisé par =SI(D30="";"";TEXTE(B30;"00")&TEXTE(C30;"0000")&TEXTE(D30;"0000"))
Les contrôles à réaliser sont les suivants :
Contrôles communs au trois concours :- Le nombre de photo par auteur. Cette valeur se trouve dans la cellule nommer Maxi_Auteur.
- Le nombre de photo par club. Cette valeur se trouve dans la cellule nommer Maxi_Club. C'est la demande de modif.
- Pour le Maxi_Auteur : Avertissement par un MsgBox vbCritical, la cellule de la colonne D est effacée et reste active afin de pouvoir ressaisir un autre N°.
- Pour le Maxi_Club : Avertissement par un MsgBox vbCritical, la cellule de la colonne D est effacée. Je pourrait même envisager de lancer une macro après validation MsgBox vbCritical (çà je sais faire).
Contrôles pour les concours 11 et 31 :- Validité de la cotisation, la cellule de la colonne U passe à 1 si l'adhérent n'est pas à jour de sa cotisation. 
- Validité de l'adhérent, la cellule de la colonne Q passe à 1 si l'auteur n'est pas adhérent.
- Pour ces deux contrôles il y aura un MsgBox vbCritical qui informera de la nullité de la saisie. Après validation du MsgBox la cellule est effacée. On repositionne la cellule active sur la première ligne vide colonne C pour le concours 31 et colonne D pour la concours11.
Contrôles pour le concours 41 :- On effectue les mêmes contrôles que ci-dessus mais le traitement est différent.
- Pour les adhérents non à jour de leur cotisation (colonne U) il n'a rien de particulier à faire. Il n'y a qu'une MFC dans la cellule « nom et prénom de l'auteur » colonne G.
- Pour les non adhérents il y aura une succession de trois MsgBox pour demander le N° de carte, le nom et le prénom. Le nom et prénom sont inscrits, après mise en forme de type nom propre, colonne I. Après validation de la dernière MsgBox la cellule active est repositionnée sur la première ligne libre colonne D. En cas d'effacement d'un N° de carte la colonne I doit être effacée également.
Voilà je t'ai tout dit, et j'espère que j'ai été clair. Fait moi simplement part de tes intentions. Je sais que je demande beaucoup mais là je suis vraiment désemparé et j'ai atteint la limite de mes connaissances. Si tu as besoin de quoique se soit d'autre surtout n'hésite pas, je suis à ton service.
Cordialement
Mistral

Mistral_13200 · Answer

Bonsoir Eric,

Fort de ton exemple concernant enableevents=false je crois en avoir compris le principe et j'ai avancé sur mon problème. J'ai doublé les condition de teste de tous les IF  et j'ai mis enableevents=false après chaque Case et ce qui me donne un fonctionnement beaucoup plus stable et qui est exactement celui que je souhaitais. Par contre es-ce correcte ?
J'ai maintenant un autre problème, pour lequel je ne sais pas dire à quel moment il est apparu : je ne compte plus les photos. Et je n'arrive pas à comprendre pourquoi ! C'est d'autant plus surprenant que la surveillance des photos est commune à tous les concours. Pourrais-tu jeter un oeil et me donner ton avis.

Ci-dessous un lien vers mon fichier modifié :

http://www.cijoint.fr/cjlink.php?file=cj201010/cijBFomuSF.xls

Dans tous les cas merci car à ton contact j'apprends beaucoup et tes conseils avisés me sont précieux.
Cordialement
Mistral

eriiic · Answer

Bonsoir,

et j'ai mis enableevents=false après chaque Case 
Normalement on le met 1 fois en début de procédure et on le rétablit en sortant.
En mettre partout ne gène pas mais sert à rien (si, à embrouiller le code...)
Vu que tu procédure est pleine de 'exit sub' (signe d'une programmation pas trop rigoureuse) j'ai dû le rétablir autant de fois.
Ce n'était pas la peine de le modifier...

je ne compte plus les photos. Et je n'arrive pas à comprendre pourquoi !
Moi non plus.
Et je ne sais même pas où, comment et avec quoi tu comptes tes photos...

eric

Mistral_13200 · Answer

Bonjour Eric,

« Signe d'une programmation pas trop rigoureuse » c'est le moins qu'on puisse dire et tu es gentil de la dire de cette façon. Je suis très loin d'être un spécialiste du VBA et je ne suis pas non plus informaticien. Je suis ce qu'on pourrait appeler un « bricoleur ». Quelques bases issues des automates programmables, l'enregistreur de macro d'Excel et ce que je peux trouver sur le net sont les piliers de ma « programmation » et je suis conscient qu'elle est loin d être optimisée. C'est le cas de cette procédure Worksheet qui au départ ne faisait que le comptage et sur laquelle j'ai rajouté les contrôles de validité.
« Vu que ta procédure est pleine de 'exit sub' (signe d'une programmation pas trop rigoureuse) j'ai dû le rétablir autant de fois. Ce n'était pas la peine de le modifier... » Tu as probablement raison mais de cette façon ça ne fonctionnait correctement que pour le concours 31, j'ai donc modifié pour arrêter la scrutation juste après chaque «Case» et la rétablir à la sortie.

Ceci étant dit, jusqu'aux dernières modifications (ne me demande pas quand exactement je ne saurais pas te le dire) je comptais bien le nombre de photos par auteur. En fait il faut compter le nombre de fois ou on a la même valeur dans la colonne F et ne pas dépasser le nombre « Maxi_Auteur » qui est contenu dans la cellule AD5 qui porte  le même nom. Je pense que le comptage est fait sur les lignes ci-dessous.
    If sel.Value = False Then sel.Value = "": Exit Sub
    If Application.WorksheetFunction.CountIf(Range("D:D"), sel.Value) > [Maxi_Auteur].Value Then
            MsgBox ("Le nombre de photos autorisé pour cet auteur" & vbCr & "est déjà atteint."), vbCritical, "Fédération Photographique de France"
            sel.Value = ""
            sel.Select
            Exit SubIl aura un autre comptage à faire, c'est la modification qu'on m'a demandée mardi, pour compter le nombre de photo maxi par concours qui est « Maxi_Club » qui est contenu dans la cellule AD6. En fait il s'agit ici de compter le nombre de ligne remplies sur le bordereau. Je pense que ces comptages sontt à faire au début de la procédure puisqu'il ne sert à rien de contrôler la validité d'un auteur s'il dépasse le Nb de photos autorisées.
J'ai bien essaye de visualiser les valeurs de ce test IF mais je n'arrive qu'à visualiser maxi. Je te remets un lien vers mon dernier fichier.

http://www.cijoint.fr/cjlink.php?file=cj201010/cijzLO3X5r.xls
Ces lignes se trouvent en début de procédure juste avant l'instruction «Case Select ».
J'espère sincèrement que tu pourras consacrer un peu de ton temps pour m'aider.
D'avance merci.
Cordialement
Mistral

Mistral_13200 · Answer

Bonjour, 
Tu comptes le nombre de N° de carte (D) dans N°adhérent (F), forcément ça fait 0.
Je dois compter les photos sur le contenu de la colonne «F» qui est le N° complet d'un adhérent sur 10 caractères. En effet pour les concours 11 et 41 le N° de carte (colonne D) pourrait suffire mais pour le concours 31 il faut compter sur le N°de Club + le N° de carte (colonne C et D).Dans les déclarations de variables ajoute dim lig as long et remplace ton test par : lig = sel.Row If Application.WorksheetFunction.CountIf(Range("F:F"), Cells(lig, 6)) > [Maxi_Auteur].Value Then 
Je vais essayer de tester cela.Attention il faut supprimer la formule de F26
Si j'efface la formule de cette colonne elle sera vide et alors sur quoi vais-je compter les photos ?Et si lors de tes tests ta procédure worksheet_change ne se déclenche plus fais toi une petite macro pour rétablir les évènements : 
Sub initEvents()
Application.EnableEvents = True 
End Sub 
eric 

PS: j'en ai une petite idée mais je serais curieux de savoir à quoi correspond au début : 
    rien = False 
    For Each cel In sel.Cells 
        If cel.Value = "" Then 
            'ActiveSheet.Unprotect ("ccm") 
            cel.Offset(0, 4).Value = "" 
            'ActiveSheet.Protect ("ccm") 
            rien = True 
        End If 
    Next cel 
    If rien Then Exit Sub Je ne saurais te répondre précisément car : Je n'ai pas écrit cette procédure elle m'a été donné et je ne l'ai jamais comprise. Tu vas probablement trouver cela surprenant mais c'est une procédure qui m'a été confié et qui a fonctionnée jusqu'à ce que je sois obligé de la modifier.Qui me parait dangereux car tu ne contrôles pas la largeur de la sélection... 
eric

Mistral_13200 · Answer

Re,

J'ai relu avec attention tous nos échanges de la semaine et je vais essayer de clarifier les choses pour toi.
Ce que je souhaiterais voir réaliser par cette procédure, chaque fois qu'une cellule de la colonne «D» au-delà de la ligne 27 :

- 1 - Pour les trois concours (11, 31et 41) : Faire un comptage de photos par auteur et par club sur le contenu de la colonne «F» qui contiendrait la formule : =SI(D28<>"";CONCATENER($B28;$C28;$D28);"") ou s'il faut la mettre au format texte =SI(D28="";"";TEXTE(B28;"00")&TEXTE(C28;"0000")&TEXTE(D28;"0000")) ces deux fonctions représentent le N° complet d'un adhérent. Les nombres à ne pas dépasser se trouvent dans deux cellules baptisées « Maxi_Auteur » pour l'une et « Maxi_Club » pour l'autre et qui sont respectivement en AD5 et AD6.
A la suite de ces deux tests on traite les trois cas ci-dessous :

- 2 - Pour le concours 11 : Tester la validité du N° de carte (colonne D) pour savoir si un auteur est :
 	- Non adhérent qui se vérifie quand  les cellules, de la ligne concernée, Q et U sont égales à 1.
 	- Non à jour de sa cotisation quand la cellule, de la ligne concernée, Q=0 et U=1.
	- A chaque test si la condition est remplie affichage d'une MsgBox pour informer du dépassement et après acquittement on efface la cellule saisie (colonne D) et repositionne la cellule active sur la première cellule vide (colonne D).

- 3 - Pour le concours 31 : Tester la validité du N° de carte (colonne D) pour savoir si un auteur est :
 	- Non adhérent qui se vérifie quand  les cellules, de la ligne concernée, Q et U sont égales à 1.
 	- Non à jour de sa cotisation quand la cellule, de la ligne concernée, Q=0 et U=1.
	- A chaque test si la condition est remplie affichage d'une MsgBox pour informer du dépassement et après acquittement on efface les cellules D et C saisies et repositionne la cellule active sur la première cellule vide  (colonne C).

- 4 - Pour le concours 41 : Tester la validité du N° de carte (colonne D) pour savoir si un auteur est :
 	- Non adhérent qui se vérifie quand  les cellules, de la ligne concernée, Q et U sont égales à 1. Si la condition est vérifiée on affiche quatre MsgBox :
	- La première pour informer que le N° doit être supérieur à 9000.
 	- La seconde pour saisir le N° de carte.
 	- La troisième pour saisir le Nom de l'auteur.
 	- La quatrième pour saisir le prénom de l'auteur.

 	- Après ces saisies le Nom et Prénom sont mis au format non propre et affichés dans la cellule de la ligne concernée en colonne « I ». La cellule active est positionnée sur la première cellule vide (colonne D).

Voilà précisément ce que je souhaite comme fonctionnement pour cette procédure.
J'espère que cela pourra t'aider
Cordialement
Mistral

Mistral_13200 · Answer

Tu n'as pas à être désolé tu n'es nullement responsable.
En tout cas merci pour ton aide.
Je vais cloturer cette question.
Chercher encore un moment et si je n'arrive à rien je relancerais une autre question.
Encore mille merci à toi.
Cordialement
Mistral

Probleme avec une Worksheet - Page 2

Discussions similaires

Newsletters