KeyDown Ereignisse auch als Doppelklick möglich?

[kathrin-Flint]

Hallo Uwe,

hatte gerade nochmal getest. Mit KeyUp verschwand das "a" allerdings, kann man mit KeyUp keine Pfeil nachoben Taste verwenden. Deshalb
KeyDown und mit deinem Tipp läufts. Danke

[kathrin-Flint]

Hallo Atilla,

danke für deinen Code. Wir haben uns gerade überschnitten. Werde ihn morgen testen. Mit Uwe's Tipp
KeyCode = 0 läuft mein Code auf jeden Fall schon mal super. Codealternativen sind natürlich immer interessant.
Auf jeden Fall hat man mit dem Doppeklick schon mal eine Funktionalitätserweiterung, die man sonst nur
von der Maus her kennt.

[atilla]

Hallo Kathrin,

kann man mit KeyUp keine Pfeil nachoben Taste verwenden

ich habe das mit der Pfeiltaste in meinem Code im Keyup getestet (Keycode 38 ;Pfeil nach oben) und es funktioniert. Oder war das jetzt keine Frage von Dir.

[ratrad]

Hallo VBA-Leute,

ich verstehe den Code von Atilla nicht:

Code:

Option Explicit
Dim gx 'globale Variable

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

   Select Case (KeyCode)
      Case (65) 'Taste A
      If CDbl(TextBox1.Tag) < Timer - 0.5 Then
         gx = 1
      Else
         gx = 2
      End If
   End Select
  
   If gx = 1 Then Er1
   If gx = 2 Then Er2
  
   TextBox1.Tag = Timer

End Sub

Public Function Er1()
   'TextBox1.Text = "" 'Textbox1 wieder leermachen
   TextBox2.Value = "Einfachklick" 'Anzeige in einer 2. Textbox um welche Art Klick es sich handelt
   debug.print "War bei Einfachklick"
End Function

Public Function Er2()
   TextBox1.Text = "" 'Textbox1 wieder leermachen
   TextBox2.Value = "Doppelklick" 'Anzeige in einer 2. Textbox um welche Art Klick es sich handelt
   debug.print "War bei Doppelklick"
End Function

Private Sub UserForm_Initialize()
   TextBox1.Tag = 0
End Sub

Der Code funktioniert bei mir nicht und meiner Meinung nach kann er auch nicht funktionieren. Habe deshalb die beiden "debug.print" in den Funktionen eingebaut.
Schaut man sich das alles mal, sieht man, dass auch beim Doppelklick vor immer bei: debug.print "War bei Einfachklick" landete. Es fehlt einfach der Zeitschalter.
Es werden also beim Doppelklick beide Funktionen aufgerufen. Ich verstehe die Logik des ganzen Codes einfach nicht.

[atilla]

Hallo ratrad,

richtig beobachtet. Der Einfachklick wird bei mir immer ausgeführt.

Damit muss ich eingestehen, dass mein Code Kathrins Wünschen nicht entspricht.

[Kuwer]

Hallo Zusammen,

ich habe mal etwas gebastelt, was über die Doppelklicksimulation hinaus geht.
Nach 300 Millisekunden Pause nach der letzten Eingabe wird der gesamte eingegebene Text ausgewertet.
Läuft aber erst ab Excel 2000 (wegen AddressOf im Timercode).

Gruß Uwe


  Schnellschreiben.xls (Größe: 49,5 KB / Downloads: 3)

[ratrad]

Hallo Uwe,

der von Dir entwickelte Code läuft bei mir nicht so recht. Probleme macht dieses Codefragment:

hEvent = SetTimer(0&, 0&, msInterval, AddressOf TimerProc)

Auch wenn dieser Code nicht mehr so viel mit der ursprünglichen Doppelclick - Idee dieses Threads gemein hat, so zeigt er doch noch ganz andere Möglichkeiten.
Habe den Code schon auf meinem Computer ausprobiert Office 2010, Laptop Office 2010 und wieder auf meinem Computer in einer virtuellen
Maschine Office 2013, aber an dieser Stelle klemmt er. Last but not least, habe 64 bit Versionen und das "PtrSafe" im Deklarationsteil schon eingefügt.

[Kuwer]

Hallo ratrad,

ersetze mal die Long durch longPtr wie hervorgehoben:

Option Explicit

Private Declare Sub GetLocalTime Lib "kernel32.dll" (lpSystemTime As SYSTEMTIME)

Private Declare Function SetTimer Lib "user32.dll" ( _
ByVal hWnd As LongPtr, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As LongPtr) As Long

Private Declare Function KillTimer Lib "user32.dll" ( _
ByVal hWnd As LongPtr, _
ByVal nIDEvent As Long) As Long

Const WM_TIMER = &H113 ' Timer-Ereignis trifft ein

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private hEvent As LongPtr
Public bytA As Byte

' Timer-Prozedur, welche im Abstand der festgelegten
' Millisekunden ein Ereignis sendet
Public Sub TimerProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long)

Dim ST As SYSTEMTIME

If uMsg = WM_TIMER Then
' Lokale Zeit ermitteln...
GetLocalTime ST

'Die auszuführenden Ereignisse
DisableTimer
bytA = bytA - 1
If bytA < 1 Then
With UserForm_Eingabe
Select Case .TextBox1.Value
Case "Hallöchen"
Application.Run "Halloechen"
Case "a", "aa", "aaa"
Application.Run CStr(.TextBox1.Value)
Case Else
.TextBox2 = .TextBox2 & vbNewLine & .TextBox1.Value
End Select
.TextBox1 = ""
End With
Else
EnableTimer 300
End If

End If
End Sub

'Sub StartTest()
' If bytA = 0 Then EnableTimer 300
' bytA = bytA + 1
'End Sub

' Startet den Timer
Public Function EnableTimer(ByVal msInterval As Long)
If hEvent <> 0 Then Exit Function
hEvent = SetTimer(0&, 0&, msInterval, AddressOf TimerProc)
End Function

' Beendet den Timer
Public Function DisableTimer()
If hEvent = 0 Then Exit Function
KillTimer 0&, hEvent
hEvent = 0
End Function

Hab ich gerade von hier: https://social.msdn.microsoft.com/Forums...f-fr-64bit

Gruß Uwe

[ratrad]

Hallo Uwe,

Dein Code funktioniert perfekt. Aber wie ich schon sagte, solltest du ihn vielleicht doch in einem eigenen Thread posten. Die Doppelclick Idee
wird hier schon sehr sehr stark erweitert. Ich fand die Idee von Kathrin interessant, habe den Code ganz ganz leicht überarbeitet und stelle
ihn hier nochmal rein. So bekommt man doch mit wirklich sehr wenig Aufwand eine nützliche Zusatzfunktion für alle Tasten geliefert.

Code:

'Code getestet
Sub TextBox1_Keydown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim sTime As Single
isEvent = True
sTime = Timer

Select Case (KeyCode)

Case (65) 'Taste A
KeyCode = 0
TextBox1.Tag = TextBox1.Tag + 1

Do
DoEvents
If Not isEvent Then Exit Sub
Loop Until Timer > sTime + 0.5 Or Timer < sTime

If TextBox1.Tag = 1 Then Er1
If TextBox1.Tag = 2 Then Er2

End Select

TextBox1.SetFocus
End Sub

Function Er1()
TextBox2.Value = "Einfachklick"
Debug.Print "War drin bei einfach" 'Kontrolle
TextBox1.Tag = 0
End Function

Function Er2()
TextBox2.Value = "Doppelklick"
Debug.Print "War drin bei doppelt" 'Kontrolle
TextBox1.Tag = 0
End Function

Sub UserForm_Initialize()
TextBox1.Tag = 0
End Sub