XL 2010 Résolu par Bebère et moi-même : pbl code change et clic sur même colonne

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,

Toujours dans mon fichier de travail, j'ai un souci d'importance que je n'arrive pas à résoudre malgré mes essais et recherches.
Je me permets de m'en remettre à votre technicité une fois de plus.

Action du code
quand l'une des cellule de P7 à P10 valeur = OK
Le code SélectionChange :
- ajoute une ligne dans la feuille RendezVous,
- copie le n° ou les n° en face du OK dans la ligne ajoutée en col H et I

Mon souci
AFFICHER UserForm et MISE à JOUR RendezVous concerne la même col P

SélectionChange s'exécute au clic
si pour changer le OK ou si clic par erreur, l'action a exécuter se répète et met à jour à tord et en doublon la feuille RendezVous.

si je mets l'action à exécuter dans le code Range qui s'exécute quand la valeur change, rien ne se passe.

J'espère avoir été "compréhensible" et je joins un classeur test qui devrait compléter mon explication.
Avec mes remerciements pour m'avoir lu,
Je vous souhaite à toutes et à tous un très heureux réveillon.
Amicalement,
Lionel,
 

Pièces jointes

  • Test change et clic.xlsm
    46.3 KB · Affichages: 26
Dernière édition:

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re à toutes et à tous,

Planchant sur mon problème, j'ai pensé qu'il faudrait inclure dans la macro "CopieTelRdV" une condition
qui bloquerait l'exécution si le ou les 2 numéros sont déjà en colonnes H ou I de la feuille RendezVous,

Je cherche à faire le code mais je n'y arrive pas.
Amicalement,
Lionel,
 
Dernière édition:

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Re à toutes et à tous,

Après une journée de recherches et d'essais, j'y suis arrivé.
je joins le classeur en pièce jointe.

Il me reste un petit truc à faire mais je devrais pouvoir le faire aussi.

LOL, trop fatigué pour ce soir.
Bonne fin de journée, à toutes et à tous,
Amicalement,
Lionel,
 

Pièces jointes

  • Test change et clic.xlsm
    48.1 KB · Affichages: 34

Bebere

XLDnaute Barbatruc
bonsoir Lionel
je te souhaite un réveil heureux

Code:
Private Sub Worksheet_SelectionChange(ByVal R As Range)
Dim cel As Range
Application.EnableEvents = False
Application.ScreenUpdating = False
    If Not Intersect(R, Range("p7:p20000")) Is Nothing And R.Count = 1 Then
    If R = "OK" Then
    Set cel = Feuil6.Columns(8).Find(ActiveCell.Offset(0, -9), LookIn:=xlValues, lookat:=xlWhole)
    If Not cel Is Nothing Then
    Feuil6.Activate
    ActiveSheet.Cells(cel.Row, cel.Column).Activate
    End If
    Else
    PratiqueSuivisAppels02.Show
    If R = "OK" And ActiveCell.Offset(0, -7) = "" Then
    CreateObject("Wscript.shell").Popup "c'est bon on passe à la feuille suivante", 1, "Bravo !!!"
    Call CopieTelRdV
    Sheets("Feuil1").Select
    ActiveCell.Offset(0, 2) = 1
    ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlNoRestrictions
    Sheets("RendezVous").Select
    Exit Sub
    End If
    If R <> "OK" Then
    ActiveSheet.Unprotect Password:=""
    ActiveCell.Offset(0, -7) = ""
    ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlNoRestrictions
    End If
    If ActiveCell.Offset(0, -7) = 1 Then
    Sheets("Feuil1").Select
    CreateObject("Wscript.shell").Popup "numéro déjà enregistré dans RendezVous", 1, "Dommage !!!"
    ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlNoRestrictions
    End If
    End If
    End If
   
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T