Discussion :

[atk_49]

Bonjour à tous.

Auriez-vous une solution fiable au bug (bien connu) de l'utilisation du sendkeys qui active ou désactive le Numlock ?

Je souhaite qu'une liste déroulante s'ouvre au premier clic et j'utilise le code suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("B4:B9, B22:B25, B36:B39, B43:B45, B53:B56, B67:B70, B82:B83, B99:B103, A131:A131"), Target) Is Nothing And Target.Count = 1 Then
Application.SendKeys "%{DOWN}"
End If
End Sub

J'ai testé sans succès les solutions suivantes :

Doevents :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("B4:B9, B22:B25, B36:B39, B43:B45, B53:B56, B67:B70, B82:B83, B99:B103, A131:A131"), Target) Is Nothing And Target.Count = 1 Then
Application.SendKeys "%{DOWN}"
Doevents
End If
End Sub

En fonction de l'état de la touche Numlock :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("B4:B9, B22:B25, B36:B39, B43:B45, B53:B56, B67:B70, B82:B83, B99:B103, A131:A131"), Target) Is Nothing And Target.Count = 1 Then
Application.SendKeys "%{DOWN}"
If GetKeyState(vbKeyNumlock) = 1 Then
Application.SendKeys "{NUMLOCK}"
End If
End If
End Sub

Pouvez-vous m'aider ? L'ouverture en un clic du menu déroulant m'est vraiment très utile.

Merci et excellente fin de journée à tous.

[Mat.M]

salut ,

1 éviter les "strings" à rallonge dans le code , cela l'obscurcit; dans l'instruction Range

2 pour répondre à la question , au pif essayer de voir si en faisant du subclassing.
Il faut essayer d'obtenir le handle de l'onglet avec l'API GetWindowLong et de gérer les instructions SendKeys.
Mais c'est une méthode peu orthodoxe...

[Marc-L]

Bonjour !

Auriez-vous une solution fiable au bug (bien connu) de l'utilisation du sendkeys qui active ou désactive le Numlock ?

Déjà ce n'est pas un bug, tout au plus une constatation, un désagrément …

La solution est simple : ne pas utiliser les SendKeys du VBA mais le SendKeys du Shell de Windows !
Parmi les nombreux exemples de ce forum voir cette discussion …

_________________________________________________________________________________________________________
Je suis Paris, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

[patricktoulon]

RE
BONSOIR

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.SendKeys "%{DOWN}"

pourquoi ne pas faire un "activecell.offset(1,0).activate ou select???????????????

[unparia]

Bonjour patricktoulon

pourquoi ne pas faire un "activecell.offset(1,0).activate ou select???????????????

pour au moins deux bonnes raisons :
- cela ne déploierait pas sa liste déroulante
- la nouvelle sélection résultante redéclencherait l'évènement selection_change, etc, etc ...

[atk_49]

Bonjour et merci à tous pour vos réponses.

Voici le code définitif et qui fonctionne dans mon cas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
If Not Intersect(Range("B4:B9, B22:B25, B36:B39, B43:B45, B53:B56, B67:B70, B82:B83, B99:B103, A131:A131"), Target) Is Nothing And Target.Count = 1 Then
Application.SendKeys "%{down}"
DoEvents
Application.SendKeys ("{NUMLOCK}"), True
Application.SendKeys ("{NUMLOCK}"), True
End If

Niveau Orthodoxie on reviendra, mais ça marche !

Bon week-end !

[Marc-L]

Ou en une seule ligne de code via le Shell SendKeys comme pourtant indiqué en clair dans le code du lien ‼

[patricktoulon]

Bonjour et merci à tous pour vos réponses.

Voici le code définitif et qui fonctionne dans mon cas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
If Not Intersect(Range("B4:B9, B22:B25, B36:B39, B43:B45, B53:B56, B67:B70, B82:B83, B99:B103, A131:A131"), Target) Is Nothing And Target.Count = 1 Then
Application.SendKeys "%{down}"
DoEvents
Application.SendKeys ("{NUMLOCK}"), True
Application.SendKeys ("{NUMLOCK}"), True
End If

Niveau Orthodoxie on reviendra, mais ça marche !

Bon week-end !

surtout que le soucis est aleatoire des fois ca coupe numlock des fois pas donc tes deux lignesnumlock ne font que repeter le problemesi numlock est en mode off tu le rallume et tu tu le re rebloque
shell un point c'est tout
bien que je ne vois toujours pas l'utilité du sendkeys dans ce cas present

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Not Intersect(Range("B4:B9, B22:B25, B36:B39, B43:B45, B53:B56, B67:B70, B82:B83, B99:B103, A131:A131"), Target) Is Nothing And Target.Count = 1 Then target.offset(1,0).select