Sendinput unter VBA7 funktioniert nicht
15.12.2022 07:19:31
mp74
ich versuche die Sendkeys Methode zu ersetzen, da dort immer Numlock toggled, wenn man F2 sendet, das nervt.
Mein erster Versuch war mit keybd_event, das geht, aber Numlock toggled genauso.
Jetzt versuche ich es mit Sendinput, aber das läuft nicht unter Windows11 Excel 2019, aber in der virtuellen Maschine mit WinXP und Excel 2007 funktioniert es.
Hat jemand eine Idee, wo das Problem ist?
Grüße
#If VBA7 Then
Private Declare PtrSafe Function SendInput Lib "user32.dll" _
(ByVal nInputs As Long, _
pInputs As GENERALINPUT, _
ByVal cbSize As Long) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDst As Any, _
pSrc As Any, _
ByVal ByteLen As Long)
#Else
Private Declare Function SendInput Lib "user32.dll" _
(ByVal nInputs As Long, _
pInputs As GENERALINPUT, _
ByVal cbSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDst As Any, _
pSrc As Any, _
ByVal ByteLen As Long)
#End If
Const VK_H = 72
Const VK_E = 69
Const VK_L = 76
Const VK_O = 79
Const VK_F2 = &H71
Const KEYEVENTF_KEYUP = &H2
Const INPUT_MOUSE = 0
Const INPUT_KEYBOARD = 1
Const INPUT_HARDWARE = 2
Private Type KEYBDINPUT
wVk As Integer
wScan As Integer
dwFlags As Long
time As Long
dwExtraInfo As Long
End Type
Private Type GENERALINPUT
dwType As Long
xi(0 To 23) As Byte
End Type
Sub Test()
Debug.Print "Test"
SendKey VK_H
SendKey VK_E
SendKey VK_L
SendKey VK_L
SendKey VK_O
End Sub
Sub Test_F2()
SendKey VK_F2
End Sub
Private Function SendKey(bKey As Byte)
Dim GInput(0 To 1) As GENERALINPUT
Dim KInput As KEYBDINPUT
KInput.wVk = bKey 'the key we're going to press
KInput.dwFlags = 0 'press the key
'copy the structure into the input array's buffer.
GInput(0).dwType = INPUT_KEYBOARD ' keyboard input
CopyMemory GInput(0).xi(0), KInput, Len(KInput)
'do the same as above, but for releasing the key
KInput.wVk = bKey ' the key we're going to realease
KInput.dwFlags = KEYEVENTF_KEYUP ' release the key
GInput(1).dwType = INPUT_KEYBOARD ' keyboard input
CopyMemory GInput(1).xi(0), KInput, Len(KInput)
'send the input now
Call SendInput(2, GInput(0), Len(GInput(0)))
End Function