XL 2010 Résolu par Lone Wolf et Paf : Code qui s'execute quand je clique

[Usine à gaz]

Bonjour à toutes et à tous,

J'ai un souci sur un code qui devrait s'exécuter au changement de valeur de ma cellule mais qui s'exécute aussi juste quand je clique sur la cellule.

Private Sub Worksheet_SelectionChange(ByVal R As Range)

Application.EnableEvents = False
Application.ScreenUpdating = False
If Not Intersect(R, Range("j7:j20000")) Is Nothing And R.Count = 1 Then 'présent(s) au RdV
    PratiqueSuivisAppels01.Show
    End If
    If Not Intersect(R, Range("p7:p20000")) Is Nothing And R.Count = 1 Then 'présent(s) au RdV
    PratiqueSuivisAppels02.Show
    If [R] = "RdV Fait" Then
    Range(R.Offset(0, -9), R.Offset(0, 1)).Select
    Call CopieTelRdV
    End If
    End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

c'est cette partie :

If [R] = "RdV Fait" Then

    Range(R.Offset(0, -9), R.Offset(0, 1)).Select
    Call CopieTelRdV
    End If

je pense que dans ce code global, ce n'est pas sa place.

j'ai tenté de l'intégrer au code suivant en remplaçant Target pas R :

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False

If Not Intersect(Target, Range("I3")) Is Nothing Then
Target.Offset(0, 0).Select
Call Telephone
End If

If Not Intersect(Target, Range("i7:i20000")) Is Nothing Then
ActiveSheet.Unprotect Password:=""
Target.Offset(0, 2) = Now()
End If

If Not Intersect(Target, Range("l7:l20000")) Is Nothing Then
   ActiveSheet.Unprotect Password:=""
   Target.Offset(0, -7) = Now()
   Target.Offset(0, 4) = ""
   Target.Offset(0, 8) = ""
   Target.Offset(0, 9) = ""
End If
end sub

Mais à cet emplacement, il ne s'exécute pas.

Auriez-vous la solution car tous mes essais n'ont pas abouti.
Avec mes remerciements,
Amicalement,
Lionel,

 

[Paf]

Bonjour arthour973,

si j'ai bien compris , dans la plage p720000, si on modifie la valeur d'une cellule, et que cette cellule= "RdV Fait" on veut exécuter la code:

    Range(R.Offset(0, -9), R.Offset(0, 1)).Select
    Call CopieTelRdV

si on veut tester la modification d'une cellule, il ne faut pas tester dans Private Sub Worksheet_SelectionChange, puisque cette sub se déclenche dès la sélection d'une cellule, avant la modification du contenu.

C'est bien dans Private Sub Worksheet_Change, comme vous l'aviez pressenti, qu'il faut déplacer le code.
Dans le code fourni pour cette sub, il n'y a pas trace d'intégration du code provenant de Private Sub Worksheet_SelectionChange !

Ce qui pourrait donner:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False

If Not Intersect(Target, Range("I3")) Is Nothing Then
Target.Offset(0, 0).Select
Call Telephone
End If

If Not Intersect(Target, Range("i7:i20000")) Is Nothing Then
ActiveSheet.Unprotect Password:="Krameri"
Target.Offset(0, 2) = Now()
End If

If Not Intersect(Target, Range("l7:l20000")) Is Nothing Then
   ActiveSheet.Unprotect Password:="Krameri"
   Target.Offset(0, -7) = Now()
   Target.Offset(0, 4) = ""
   Target.Offset(0, 8) = ""
   Target.Offset(0, 9) = ""
End If

If Not Intersect(Target, Range("p7:p20000")) Is Nothing And Target.Count = 1 Then 'présent(s) au RdV
  PratiqueSuivisAppels02.Show
  If Target = "RdV Fait" Then
      Range(Target.Offset(0, -9), Target.Offset(0, 1)).Select
      Call CopieTelRdV
  End If
End If
end sub

Dans cette sub, pensez à réactiver Application.EnableEvents et Application.ScreenUpdating qui sont désactivés en début de sub.

A+

 

[Usine à gaz]

Bonjour Paf,

Merci de m'avoir répondu en cette veille de Noel.
J'ai essayé votre code mais ça ne fonctionne pas.
je vais tenter de faire plus clair en explication LOL
J'ai refais le code comme suit :

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False

If Not Intersect(Target, Range("p7:p20000")) Is Nothing Then
If Target = "RdV Fait" Then
    Call CopieLigne
    Sheets("SuivisAppels").Select
    Range(Target.Offset(0, -9), Target.Offset(0, 1)).Select
    Selection.Copy

    Sheets("RendezVous").Select
    ActiveSheet.Cells(Rows.Count, "h").End(xlUp)(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(0, -2).Select
    ActiveSheet.Protect Password:="Krameri", DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlNoRestrictions
    End If
    End If

If Not Intersect(Target, Range("I3")) Is Nothing Then
Target.Offset(0, 0).Select
Call Telephone
End If

If Not Intersect(Target, Range("i7:i20000")) Is Nothing Then
ActiveSheet.Unprotect Password:=""
Target.Offset(0, 2) = Now()
End If
end sub

Quand je modifie dans ma feuillle "target", en colonne P (valeur 'RdV fFait" + Grrr !!! il ne se passe rien
Lionel,

 

[Usine à gaz]

Etant novice en VBA (vous vous en êtes aperçu LOL), j'ai un doute :
le code "Application.EnableEvents = False" bloque l'exécution des autres codes sauf le code en action ?

 

[eriiic]

Bonjour,

Application.EnableEvents = False interrompt la supervision des événements.
Il faut le rétablir ensuite avec =True si tu veux que ça re-fonctionne.
eric

 

[Usine à gaz]

Merci éric,
OUI, ça je l'avais appris mais le False ne bloque pas le code en cours ?

 

[Usine à gaz]

Re,
J'ai compris mais je ne sais pas modifier.
C'est ce code dans la même feuille qui me bloque :

Private Sub Worksheet_SelectionChange(ByVal R As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
    If Not Intersect(R, Range("p7:p20000")) Is Nothing And R.Count = 1 Then 'présent(s) au RdV
    PratiqueSuivisAppels02.Show
    End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

J'ai pourtant bloqué (code post 3) par : Application.EnableEvents = False dans l'autre code.

 

[Paf]

re , et bonjour eriiiic,

je vais tenter de faire plus clair en explication LOL

Hélas !! Dans ce post, il n'y a aucune explication !! Juste un code qui ne donne pas satisfaction!!

Au début, je n'étais pas sûr de cerner le souci, vous n'avez ni validé ni invalidé mon hypothèse, mais avec tous ces codes fournis, désormais, je suis dans le flou complet!

Que tentez vous de faire exactement ?

a priori il doit se passer plusieurs choses à la modification d'une cellule de la plage p720000 ??

A+

 

[Usine à gaz]

Merci Paf,

Je suis en train de faire un fichier test ...... je ne pensais pas que c'était indispensable mais bien sur que si

 

[Usine à gaz]

J'ai enfin réussi à faire un fichier test.
je pense que les explications dans la feuille "SuivisAppels" sont claires (du moins je l'espère LOL)

 

[Paf]

Re,

Si je comprend bien (?) c'est l'appel à l'USF qui poserait problème ?
Pas facile de se rendre compte puisque l'appel en question et l'USF ne figurent pas dans le classeur joint !

a priori en inversant les lignes de codes ça devrait le faire

......
If Not Intersect(Target, Range("p7:p20000")) Is Nothing And Target.Count = 1 Then 'présent(s) au RdV

   ' 1 )  on traite "RdV Fait"
  If Target = "RdV Fait" Then
      Range(Target.Offset(0, -9), Target.Offset(0, 1)).Select
      Call CopieTelRdV
  End If

   ' 2 ) on affiche l'USF
  PratiqueSuivisAppels02.Show
End If
.....

Dans cette sub, n'oubliez pas de réactiver Application.EnableEvents et Application.ScreenUpdating qui sont désactivés en début de sub ( non fait dans le classeur joint).

A+

 

[Usine à gaz]

Merci Paf, ça fonctionne mais je reviens à mon premier souci.
L'exécution doit se faire au changement de valeur de la cellule et pas au clic car si par erreur on re-clique, l'opération se répète de façon intempestive.

 

[Usine à gaz]

En fait, le code est dans un code qui s'exécute au clic alors qu'il doit s'exécuter uniquement au changement de valeur

 

[Lone-wolf]

Bonsoir à tous

Lionel, si je peux me permettre. Dans l'évenement change, il faut inscrire les lignes dans l'ordre, EnableEvents est prioritaire aux autres application. Il doit être inscrit toujours en début et fin de l'évenement Change et ScreenUpdating = True n'est pas obligatoire.

Private Sub Worksheet_Change(ByVal R As Range)
Dim i, x, cel, plage

Application.EnableEvents = False
Application.ScreenUpdating = False

La Macro

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[Usine à gaz]

Bonjour Lone,
Bien sur et merci de te permettre, je vais voir.