Microsoft 365 au clic ou à la sélection la liste s'ouvre sans avoir à cliquer sur la flèche en bas

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonjour à toutes et à tous,

en D4 et D17, j'ai en validation des données une liste .Je souhaite qu'au clic ou à la sélection cellule la liste déroulante s'ouvre sans avoir à cliquer sur la flèche en bas.

Malgré mes tests et recherches, je n'ai pas trouvé de solution.
Le dernier code (dans la feuille) que j'ai tenté est le suivant :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "d4" And Target.Count = 1 Then
  CreateObject("wscript.shell").SendKeys "%{down}"
  End If
  If Target.Address = "d17" And Target.Count = 1 Then
  CreateObject("wscript.shell").SendKeys "%{down}"
  End If
End Sub
Mais, rien à faire, je n'y arrive pas :mad:
Auriez-vous la solution ?
Je vous remercie déjà pour m'avoir lu et je joins un petit fichier test.
Bonne fin de journée à toutes et à tous,
Amicalement,
lionel,
 

Pièces jointes

  • test.xlsm
    25.8 KB · Affichages: 4

job75

XLDnaute Barbatruc
Bonjour Lionel, sylvanu,
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$D$4" Or Target.Address = "$D$17" Then CreateObject("wscript.shell").SendKeys "%{down}"
End Sub
A+
 

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
Bonsoir Sylvanu, Bonsoir Gérard, le Forum,

Je reviens sur le fil. Les solutions fonctionnent très bien sur le fichier test mais pas dans mon fichier de travail et je ne comprends pas pkoi :mad:

j'ai intégré le code de Gérard dans les codes :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("$b$3")) Is Nothing Then: CreateObject("wscript.shell").SendKeys "%{down}"
et
If Not Intersect(Target, Range("$b$7")) Is Nothing Then: CreateObject("wscript.shell").SendKeys "%{down}"
Pourtant le code fonctionne ici :
Code:
If Not Intersect(Target, Range("b10")) Is Nothing Then
If [a10] = "" Or [a10] = "N° ?" Or [a10] = "ERREUR N° - ERREUR N°" Then
Application.EnableEvents = False
MsgBox ("B7 : PAS DE N° ou ERREUR N° !")
[b7] = ""
[b10] = ""
[a1].Select
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Exit Sub
Else
CreateObject("wscript.shell").SendKeys "%{down}"

Mais pour B10, ce n'est pas un clic mais un déplacement par macro (une sélection.
C'est peut-être pour ça.
Je n'arrive pas à trouver.

Pourriez-vous encore m'apporter votre aide.
En cas, je joins le fichier.
Avec mes remerciements, je vous souhaite une belle journée :)
lionel,
 

Pièces jointes

  • Projet_g1.xlsm
    93.9 KB · Affichages: 2

Discussions similaires

Haut Bas