AW: KeyDown-Ereignis für Worksheet / was Ähnliches?
02.07.2007 15:14:00
Nepumuk
Hallo Jens,
ich kann das nur simulieren, aber eine 100%-Garantie, dass es auf jeden Tastendruck reagiert und das auch nur genau einmal, kann ich nicht geben.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Workbook_Open()
If ActiveSheet Is Tabelle1 Then Call prcStartTimer
End Sub
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Worksheet_Activate()
Call prcStartTimer
End Sub
Private Sub Worksheet_Deactivate()
Call prcStopTimer
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" ( _
ByVal dwMilliseconds As Long)
Private Declare Function GetAsyncKeyState Lib "user32.dll" ( _
ByVal vKey As Long) As Integer
Private Declare Function KillTimer Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long
Private Declare Function SetTimer Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Const GC_CLASSNAMEMSEXCEL = "XLMAIN"
Private hWnd As Long
Public Sub prcStartTimer()
hWnd = FindWindow(GC_CLASSNAMEMSEXCEL, Application.Caption)
SetTimer hWnd, 0, 50, AddressOf prcTimer
End Sub
Public Sub prcStopTimer()
KillTimer hWnd, 0
End Sub
Private Sub prcTimer(ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
On Error Resume Next
Call prcMonitorKeyboard
End Sub
Private Sub prcMonitorKeyboard()
Dim lngIndex As Long
For lngIndex = 32 To 254
If GetAsyncKeyState(lngIndex) <> 0 Then
Beep
Sleep 300 - lngIndex
Exit For
End If
Next
End Sub
Gruß
Nepumuk