Raccourcis clavier en Vba
Bonjour tout le monde.
J'ai un petit soucis sur du code vba que j'ai, je suis bloqué, je ne comprend vraiment pas ce qui bloque, quelqu'un aura peut êter une idée pour moi ?
Le but du code est simple, associer un sendkey à un raccourci clavier. Exemple, j'appuie sur CTRL + D et ça me fait sendkey, "toto".
Le code ci dessous fonctionne la première fois que j'appuye sur le raccourcis. Par contre si je refais le raccourcis dans les 3/4 secondes aprés, ça ne m'envoit plus toto, mais des caratères étranges. Si j'attends plus de 5s entre deux raccourcis, ça fonctionne bien ... Quelqu'un aurait une idée pour moi s'il vous plait ? Merci d'avance !
Voilà le petit bout de code : (je suis sur vba d'excel 2003)
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
| Private Const MOD_ALT = &H1
Private Const MOD_CONTROL = &H2
Private Const MOD_SHIFT = &H4
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type msg
hWnd As Long
message As Long
Wparam As Long
lparam As Long
time As Long
pt As POINTAPI
End Type
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As Long
Private Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, _
ByVal id As Long, _
ByVal fsModifiers As Long, _
ByVal vk As Long _
) As Long
Private Declare Function UnregisterHotKey Lib "user32" ( _
ByVal hWnd As Long, _
ByVal id As Long _
) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" ( _
lpMsg As msg, _
ByVal hWnd As Long, _
ByVal msgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wremoveMsg As Long _
) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
sub test()
Dim message As msg
Dim messageVoid As msg
ffa = RegisterHotKey(WinID, &HBFFF, MOD_CONTROL, vbKeyQ)
Do
WaitMessage
If (PeekMessage(message, WinID, WM_HOTKEY, WM_HOTKEY, PM_REMOVE)) Then
testString = "toto"
SendKeys testString, True
End If
DoEvents
Loop
End sub |
