XL 2016 msgbox si double clic ou clic droit sur cellule au lieu d'1 seul clic

[Usine à gaz]

Bonjour à toutes et à tous,

Je bute sur un code que je n'arrive pas à faire fonctionner malgré mes recherches et essais.

J'ai fait les codes suivants :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Application.Intersect(Target, Range("l1:l10000")) Is Nothing Then
    MsgBox ("Il ne faut pas double cliquer dans cette colonne !" & nbcel)
    Cells(ActiveCell.Row, 1).Select
    Exit Sub
    End If
    End Sub

Private Sub Worksheet_SelectionChange(ByVal R As Range)
If Not Intersect(R, Range("l1:l10000")) Is Nothing And R.Count = 1 Then
    MsgBox ("Bravo vous n'avez cliqué qu'une fois !" & nbcel)
    End If
End Sub

Mais même si on double clic par erreur, c'est le code "Private Sub Worksheet_SelectionChange(ByVal R As Range)"

Ma question : Est-il possible que si on double clic, que ce soit le double clic qui s'exécute en 1er ?

Un grand merci pour vos réponses.
Bonne fin de journée à toutes et à tous,
Amicalement,
lionel,

 

[Dranreb]

S'il n'y a pas le double clic à prévoir (vu que 0,15 seconde me semble insuffisant pour l'effectuer), on peut faire comme ça :
Module standard :

Option Explicit
Public RngCible As Range, ClicDroit As Boolean
Sub SélectionDifférée()
   If ClicDroit Then Exit Sub
   MsgBox "SélectionDifférée " & RngCible.Address
   End Sub

Module de l'objet Worksheet :

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Set RngCible = Target
   ClicDroit = False
   Application.OnTime Now, "SélectionDifférée"
   End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   Cancel = True
   ClicDroit = True
   MsgBox "BeforeRightClick " & Target.Address
   End Sub

Apparemment il faut que la Worksheet_SelectionChange se termine pour que la Worksheet_BeforeRightClick puisse s'exécuter. Mais si on y planifie par Application.OnTime une autre procédure pour tout de suite, elle est quand même exécutée après la Worksheet_BeforeRightClick. On peut donc tester si celle ci a eu lieu, si elle s'est manifestée en mettant à True un Public ClicDroit As Boolen.

 

[Dranreb]

On n'a d'ailleurs pas besoin de cette variable ClicDroit, on peut aussi tout simplement faire comme ça :
Module standard :

Option Explicit
Public RngCible As Range
Sub SélectionDifférée()
   If RngCible Is Nothing Then Exit Sub
   MsgBox "SélectionDifférée " & RngCible.Address
   End Sub

Module de l'objet Worksheet :

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Set RngCible = Target
   Application.OnTime Now, "SélectionDifférée"
   End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   Set RngCible = Nothing
   Cancel = True
   MsgBox "BeforeRightClick " & Target.Address
   End Sub

 

[patricktoulon]

bonjour a tous
l'idée de Dranreb est astucieuse
je raccourci le temps mais problème avec le right_click

Option Explicit
Public evenement As Long, RngCible As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim t
t = Timer: Do: DoEvents: Loop While Timer - t < 0.2 '0.3 ou plus pour les doubleclick lents
    Set RngCible = Target
    MsgBox evenement
    evenement = 0
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    evenement = 2
    Set RngCible = Target
    Cancel = True
End Sub

'pour une raison que j'ignore le rightclick demande  une attente plus longue
'peut etre que  que l'evenement interne passe en revu les 3 evenement VBA
'pourtant selon moi ce devrait etre le doubleclick le plus long
'Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    'evenement = 1
    'Set RngCible = Target
    'Cancel = True
'End Sub

 

[Roland_M]

Bonjour tout le monde,

Lionel, je sais pas comment est conçu ton classeur,
mais sur cette feuille, si les saisies avec:
simple clic sont dans une colonne exp A
double clic sont dans une colonne exp B
clic droit sont dans une colonne exp C
ça ne pose aucun problème avec les événements puisqu'il suffit de tester
If Not Application.Intersect(R, Range( . . .

mais évidemment si tous les événement sont dans la même colonne ça pose problème
peut être simplement revoir la structure de ta feuille !?
et ne pas prendre le problème à l'envers, mal conçu et tourner autour !
revoir la conception avec les données sur la feuille !?

 

[Usine à gaz]

Bjr Roland,
Bjr Dranreb,
Bjr patrick,
Le Forum,

Un grand merci encore pour vos codes
Je regarde dans la journée et je vous dirai
lionel,

 

[Usine à gaz]

OUI, Roland, mon fichier est mal conçu,

Quand je l'ai créer, je n'y connaissais vraiment rien en VBA et je l'ai fait évoluer en fonction de mon évolution.
Donc des ajouts de codes et de fonctionnalités "barbares".
Aujourd'hui, il me faut du temps pour le refaire car, grâce à vous, je suis capable de le refaire.
Mais pas le temps et je dois m'en débrouiller comme il est pour l'instant.

La feuille en question est la feuille la plus importante et le codes est devenu trop compliqué pour que je puisse le refaire maintenant.

Mais tu a raison, il faudrait tout refaire différemment pour que ce soit bien.
lionel,

 

[Dranreb]

Bonjour.
Il va de soit que si les trois procédures sont utilisées les codes doivent tous y être encadrés d'un Select Case Target.Column pour déterminer les actions à effectuer. Avec en plus d'abord un If Target.Columns.Count > 1 Then Exit Sub pour la Selection_Change. C'est bien le cas dans ton classeur, quand même ?
Et effectivement si pour chaque colonne c'est soit la Selection_Change qui doit opérer soit une des deux autres il n'y a pas de problème. Il suffit de mettre des Case X: Exit Sub dans la Selection_Change pour les colonnes X pour lesquelles c'est soit un clic droit soit un double clic qui doit opérer. Ou même rien, d'ailleurs, puisque les Case X des colonnes X spécifiques ont été traités.

 

[Usine à gaz]

Re-Bjr Roland,
Bjr Dranreb,
Bjr patrick,
Le Forum,

Super de chez super

Je viens de prendre une pause dans mon boulot et j'ai testé le 1er nv module de Dranreb :

Option Explicit
Public RngCible As Range, ClicDroit As Boolean
Sub SélectionDifférée()
   If ClicDroit Then Exit Sub
   MsgBox "SélectionDifférée " & RngCible.Address
   End Sub

Et j'ai mis dans le code de la feuille Dranreb2 le code suivant :

Option Explicit
Private DblClic As Boolean

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Not Application.Intersect(Target, Range("l1:l10000")) Is Nothing Then
   DblClic = True
   MsgBox "1 seul clic ici"
   ActiveCell = ""
   Cells(ActiveCell.Row, 1).Select
   Exit Sub
   End If
   Cancel = True
   End Sub

Private Sub Worksheet_SelectionChange(ByVal R As Range)
If Not Intersect(R, Range("l7:l10000")) Is Nothing And R.Count = 1 Then
   Dim TDéb As Single
   DblClic = False
   TDéb = VBA.Timer
   Do: DoEvents: Loop Until VBA.Timer - TDéb > 0.15
   If DblClic Then Exit Sub
   ActiveCell = "OK 1 clic c'est bon"
   'MsgBox "OK 1 clic c'est bon"
   End If
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("l1:l10000")) Is Nothing Then
   Cancel = True
   ClicDroit = True
   'MsgBox "BeforeRightClick " & Target.Address
   MsgBox "1 seul clic ici"
   ActiveCell = ""
   Cells(ActiveCell.Row, 1).Select
   End If
   End Sub

et ça fonctionne nickel de chez nikel

Je testerai le second code de Dranreb et celui de Patrick dès que j'aurai à nouveau un peu de temps.
Mais la c'est super nikel, merci Dranreb.
Je joins le fichier voir en feuille "Dranreb2",
@plus
lionel,

 

[Dranreb]

Assez incohérent tout ça …
Mais comme dit, si aucune colonne ne nécessite d'actions différentes à la fois d'une Selection_Change ou d'un clic droit ou double, pas besoin de toutes cette gymnastique. Voir poste #35.

 

[Roland_M]

re

content pour toi Lionel si ça marche !?

'astuce concernant les boucles avec Timer

'évidemment qu'il faut vraiment une sacrée coïncidence
'mais j'ai eu le tour sur un logiciel qui tournait 24/24
'et cette coïncidence était arrivée, plantage !
'86400 minuit Timer repart à 0
'0 - 86400 = résultat négatif!

'ceci bouclerait en continue !
TDéb = VBA.Timer
Do: DoEvents: Loop Until VBA.Timer - TDéb > 0.15

'perso j'utilise comme ceci:
TDéb = VBA.Timer
While Abs(VBA.Timer - TDéb) < 0.15: Wend

 

[Dranreb]

D'accord Roland_M. Je n'aime d'ailleur pas becoucoup VBA.Timer, en partie à cause de ça. Je préfère les API GetTickCount, qui n'est pas plus précis, ou le couple QueryPerformanceCounter et QueryPerformanceFrequency qui est parfait.

 

[Usine à gaz]

Merci Roland pour ton message
Je pense que le code de Dranreb sera certainement utile à beaucoup de personnes qui désirent orienter les clics selon les cellules ou colonnes.

Merci aussi pour ce que tu me dis pour le Timer
je vais en tenir compte.
lionel,

 

[Dranreb]

Le mieux qu'on puisse faire sans délai d'attente c'est ça.
Mais ça ne permet pas d'empêcher l'exécution de la SelectionDifférée avant la BeforeDoubleClick, tandis que la BeforeRightClick, elle, l'empêche.

 

[Usine à gaz]

Merci Dranreb pour ce nouveau fichier.

Je vais regarder ça me semble également super bien (quel travail pour toi vraiment merci).
Toutefois, le fichier que j'ai joint au post 38 (avec tes codes ), fonctionne et correspond parfaitement à mon besoin .

Je te dirai dès que j'aurai un moment (ce soir si je ne suis pas mort de fatigue LOl).
lionel,