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
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.
Hallo Kathrin,
Zitat: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.
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.
Hallo ratrad,
richtig beobachtet. Der Einfachklick wird bei mir immer ausgeführt.
Damit muss ich eingestehen, dass mein Code Kathrins Wünschen nicht entspricht.
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
[
attachment=957]
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.
Hallo ratrad,
ersetze mal die Long durch longPtr wie hervorgehoben:
Zitat: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
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