422 Aufrufe
Gefragt in Windows 10 von pclaus
Ich erstelle ein kleines "Programm" im Excel mit VBA, das am Monitor ein Farbfeld generiert, dem auf der Tastatur ein zugeordnetes Zeichen entspricht, das möglichst schnell eingegeben werden soll.
Die Zeit vom Erscheinen des Farbfeldes bis zur Eingabe wird dabei gemessen. Dafür kann ich aber nicht das zusätzliche Drücken der Enter-Taste brauchen.
Die Lösung des Problems hab ich bisher auf 3 Ebenen gesucht, leider ohne Erfolg.
1) In den Optionen von Excel.
2) Auf der Tastatur selbst und
3) über Makros.
Hier müsste mein bestehendes Makro an einer bestimmten Stelle der Ausführung automatisch unterbrochen werden, um das Zeichen (ohne Entertaste) manuell eingeben zu können. Unmittelbar danach sollte das Makro (ohne manuelle Aktivierung) weiterlaufen, denn da wäre ja dann das Enter drinnen.
Die kurze Dauer der Makro-Ausführung wäre für die Zeitmessung vernachlässigbar, sodass nur die tatsächliche Zeit bis zur Eingabe des Zeichens gemessen würde.
Wichtig: Keine zeitabhängige Unterbrechung, denn dann würde entweder nichts gemessen (Zeit zu kurz) oder immer nur die Dauer der Unterbrechung (Zeit ausreichend oder zu lang).
Ich habe es schon mit If-Codes versucht, aber dann ging gar nix mehr.
Bitte um Eure Hilfe!
LG PClaus

24 Antworten

0 Punkte
Beantwortet von
Hallo PClaus,

Um Reaktionstests durchzuführen gibt es sicherlich bessere Software als Excel. Aber natürlich das trotzdem möglich. Leider hast du keinen Code gepostet. Hast du den in einem UserForm oder in einem Standardmodul?

Also war ich mal so frei, selbst ein paar simple Zeilen runterzuklackern. Bei mir muss man lediglich A bei Rot, S bei Grün oder D bei Blau drücken. Dein Code ist dann sicher etwas umfangreicher.

Für dich ist v.a. der Teil mit KeyPressed interessant. Hier wird nämlich eine Windowsfunktion verwendet, die überprüft ob eine bestimmte Taste gedrückt wurde.

[code]Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer
Sub ReaktionMessen()

'Code zum Berechnen der Zufallsfarbe z.B.
Randomize Timer
FeldBreite = 50: Feldhoehe = 50 'Größe des Rechtecks
Messbereich = "A1:A20"


'Normale Tasteneingabe abschalten
Application.OnKey "a", ""
Application.OnKey "s", ""
Application.OnKey "d", ""

Range(Messbereich).ClearContents

For i = 1 To Range(Messbereich).Cells.Count '20 Durchläufe bis Ende
  
  'Zufallsgenerator berechnet eine der drei Farben Rot, Grün oder Blau
  Farbe = Choose(Int(Rnd * 3) + 1, RGB(255, 0, 0), RGB(0, 255, 0), RGB(0, 0, 255))
  
  'Zufallsgenerator berechnet, wann innerhalb der nächsten 10 Sekunden das Feld kommt
  Start = Timer + Rnd * 10
  Do:  Loop Until Timer >= Start
  
  'Feld wird jetzt gezeichnet
  FeldTop = Application.UsableHeight / 2 - Feldhoehe / 2
  FeldLeft = Application.UsableWidth / 2 - FeldBreite / 2
  Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, FeldLeft, FeldTop, FeldBreite, Feldhoehe)
  shp.Fill.ForeColor.RGB = Farbe
  DoEvents
  
  'Warten auf Tastendruck
  Start = Timer
  Do
    Select Case Farbe
    Case RGB(255, 0, 0)
      KeyPressed = GetAsyncKeyState(vbKeyA)
    Case RGB(0, 255, 0)
      KeyPressed = GetAsyncKeyState(vbKeyS)
    Case RGB(0, 0, 255)
      KeyPressed = GetAsyncKeyState(vbKeyD)
    End Select
  Loop Until KeyPressed
  
  Range(Messbereich).Cells(i) = Timer - Start
  
  'Feld wird gelöscht
  shp.Delete
  DoEvents
Next i

'Normnale Tasteneingabe wieder einschalten
Application.OnKey "a"
Application.OnKey "s"
Application.OnKey "d"

MsgBox "Herzlichen Glückwunsch. Sie haben den Test erfolgreich beendet.", vbInformation, "Farbtest"

End Sub[/code]Ich liege im Durchschnitt übrigens zwischen 0,3 und 0,6 Sekunden. Ist das gut?

Gruß Mr. K.
0 Punkte
Beantwortet von
Hi nochmal. Mir fällt grad noch ein, dass mein Excel ja schon etwas älter ist. Falls du planst die Datei auch
auf anderen Rechnern (z.B. bei Freunden oder Kunden) einzusetzen, solltest du die erste Zeile "Declare
Function usw." durch dieses Konstrukt ersetzen. Das beugt eventuellen Problemen mit Office 64bit vor.

#If VBA7 Then
    Declare PtrSafe Function GetAsyncKeyState Lib "USER32" (ByVal vKey As Long) As Integer
#Else
    Declare Function GetAsyncKeyState Lib "USER32" (ByVal vKey As Long) As Integer
#End If

Gruß Mr. K.
0 Punkte
Beantwortet von pclaus
Hallo xlKing,
danke für deine Antwort, habe deinen vorschlag versucht, auch mit den neuen FunctionCodes, leider ohne Erfolg, Excel stürzt ab - keine Rückmeldung (von Excel natürlich!)
Lg PClaus
0 Punkte
Beantwortet von
Hmm, merkwürdig. Das ist die Variante man für Office 64bit auch überall im Netz finden kann. Bei mir funktioniert ja noch die alte Version tadellos.

Welche Excel Version hast du eigentlich? Liegt dier eine 64bit Version vor? Falls ja dann probier mal für die erste Declare Zeile diese Variante:

[code]Private Declare PtrSafe Function GetAsyncKeyStateA Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As LongPtr) As Integer[/code]

oder von mir aus auch

[code]Private Declare PtrSafe Function GetAsyncKeyStateA Lib "user32" Alias "GetAsyncKeyState" (ByVal vKey As LongPtr) As LongLong[/code]

Ist vom Prinzip eigentlich egal aber vielleicht hilfts.

Falls nicht, führe das Makro mal im Einzelschrittmodus aus und sag mir bei welcher Zeile der Absturz kommt.
0 Punkte
Beantwortet von pclaus
ich hab Excel 2013 32-bit
sorry, keine Ahnung, wie man das Makro im Einzelschrittmodus ausführt.
VBA markiert schon die Zeile "Sub Makro1()" gelb.
Ich schick dir die ersten Zeilen des Makros:

#If VBA7 Then
Declare PtrSafe Function GetAsyncKeyState Lib "USER32" (ByVal vKey As Long) As Integer
#Else
Declare Function GetAsyncKeyState Lib "USER32" (ByVal vKey As Long) As Integer
#End If

Sub Makro1()

' Makro1 Makro
'

''Code zum Berechnen der Zufallsfarbe z.B.
Randomize Timer
FeldBreite = 50: Feldhoehe = 50 'Größe des Rechtecks
Messbereich = "A1:A20"


'Normale Tasteneingabe abschalten
Application.OnKey "a", ""
Application.OnKey "s", ""
Application.OnKey "d", ""

Range(Messbereich).ClearContents

For i = 1 To Range(Messbereich).Cells.Count '20 Durchläufe bis Ende
  
  'Zufallsgenerator berechnet eine der drei Farben Rot, Grün oder Blau
  Farbe = Choose(Int(Rnd * 3) + 1, RGB(255, 0, 0), RGB(0, 255, 0), RGB(0, 0, 255))
  
  'Zufallsgenerator berechnet, wann innerhalb der nächsten 10 Sekunden das Feld kommt
  Start = Timer + Rnd * 10
  Do:  Loop Until Timer >= Start

Hätte ich deine Anmerkungen weglassen sollen?
Ich kenn mich bei VBA sichtlich nicht so aus!
0 Punkte
Beantwortet von
[quote]VBA markiert schon die Zeile "Sub Makro1()" gelb.[/quote]
Genau das ist der Einzelschrittmodus. Drück einfach immer wieder auf die Taste F8 um dich Zeile für Zeile durchzuhangeln. Dann
siehst du eher, wo das Problem liegen könnte. Die Kommentare sind egal. Hast du überhaupt die Datei User32.dll auf deinem
Computer? Liegt z.B. unter C:\Windows\System32 oder im Pfad C:\Windows\SysWOW64. Die wird dafür benötigt. Ansonsten fällt mir
momentan leider nicht mehr allzuviel dazu ein. Ferndiagnosen sind halt immer schwierig. Welches Windows hast du?
0 Punkte
Beantwortet von pclaus
also: ich hab User32.dll und die liegt in C:\Windows\System32, wie du richtig vermutet hast. Ich hab Windows 10.
Ich hab das makro mit F8 schrittweise untersucht, am schluss bleiben die markierungen der Zeilen innerhalb der Schleife und eine der farben erscheint im Excel. Wenn ich dann das Makro fortfahren will, stürzt das Excel ab.
LG und gute Nacht!
0 Punkte
Beantwortet von
Hmm, dachte ich mir schon. Dreh- und Angelpunkt ist nunmal diese Funktion. Bei mir und Allen Anderen klappts doch auch.

Letzter Versuch, dann geb ich auf: Ersetze den Teil von Select Case bis End Select durch
[code]Select Case Farbe
    Case RGB(255, 0, 0)
      KeyPressed = CBool(GetAsyncKeyState(vbKeyA) And &H1)
    Case RGB(0, 255, 0)
      KeyPressed = CBool(GetAsyncKeyState(vbKeyS) And &H1)
    Case RGB(0, 0, 255)
      KeyPressed = CBool(GetAsyncKeyState(vbKeyD) And &H1)
End Select[/code]Das &H1 hatte ich absichtlich weggelassen um genauere Messungen im Millisekundenbereich zu ermöglichen.
Das Weglassen hat normalerweise keine Auswirkungen. Aber vielleicht reagiert dein System ja anders.

Mach auch mal testweise nur eine der beiden Declare Zeilen:
also entweder [i]Declare PtrSafe Function GetAsyncKeyState Lib "USER32" (ByVal vKey As LongPtr) As Integer[/i]
oder [i]Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer[/i]

Wenn auch das fehlschlägt dann prüfe, ob im VBA Editor unter Extras -> Verweise ein [url=https://support.office.com/de-
de/article/hinzuf%C3%BCgen-von-objektbibliotheken-zum-visual-basic-projekt-ed28a713-5401-41b0-90ed-
b368f9ae2513]Verweis[/url] auf Visual Basic for Applications gesetzt (also angehakt) ist.
Schau dann noch im [url=http://www.vba-wordwelt.de/grundsaetzliches/vba-editor/objektkatalog/]Objektkatalog[/url]nach, ob es die
verwendeten Konstanten vbKeyA, vbKeyS, vbKeyD überhaupt noch gibt. Ich gehe davon aus, dass beides bereits vorhanden ist.

Übrigens: Vielleicht stürzt ja Excel nicht wirklich ab, sondern erwartet einfach nur einen Tastendruck auf die Tasten A S oder D. Die
Dauerschleife auf diese Tasten wartet kann u.U. wie ein Absturz wirken. Meist lässt sie sich aber auch durch Druck auf die Esc-
Taste abbrechen.

Das waren meine allerletzten Ideen. Wenn das nicht hilft, weiß ich leider auch nicht mehr weiter. Muss eben jemand mit
Excel2013 und Windows10 ran. Für den Moment wünsch ich dir erstmal eine gute Nacht.
0 Punkte
Beantwortet von pclaus
Hallo xlKing,
danke dir vielmals für deine Mühe, egal, obs funktioniert oder nicht!
Ich probier jetzt einmal all deine vorschläge durch und sag dir dann bescheid.
LG PClaus
0 Punkte
Beantwortet von pclaus
Also:
Ich habe deine Vorschläge mit den Declare Zeilen versucht, -> excel stürzt ab. Nein, ich warte schon bis das Excel sagt Keine Rückmeldung und alles blass wird.
Ja, Verweis auf VBA ist gesetzt und ja, die Konstanten vbKeyA, vbKeyS, vbKeyD gibt es.
Ich hätte aber einen anderen Vorschlag:
Ich habe ja viele Schritte, die du in VBA programmiert hast (Farbauswahl, Zuordnung zu Buchstaben, Zeitrechnung etc.) schon im Excel "programmiert" und lasse das VBA nur diese Schritte aneinanderreihen mit "Aufzeichnen", viel mehr kann ich im VBA nicht. Natürlich schaue ich mir dann die Codes der Aufzeichnung an und versuche, daraus zu lernen.
Was mir dzt. fehlt, ist ein Code, der es ermöglicht, dass die VBA-Ausführung bei Erscheinen des Farbfeldes so lange unterbrochen wird, bis der Nutzer eine Taste drückt (ohne Enter!), dann das Programm sofort weiterläuft und damit selbst das Enter generiert. Auswertung, ob wahr oder falsch und zeitrechnung mach ich schon wieder im Excel.
Ich schicke dir mein VBA und bitte dich, dass du mir vielleicht so einen Code eingeben könntest?! Ich lasse im VBA die Zeile frei, wo das programm auf die Eingabe warten sollte, ist das o.k.? Vielleicht brauchen wir dann gar keine Declare Zeile?

Sub Start()
'
' Start Makro
'

'
    Range("D5").Select
    Selection.Copy
    Range("E5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D18").Select
    
    Range("D18").Select
    Selection.Copy
    Range("D19").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("D18").Select
    Selection.ClearContents
End Sub

Vielleicht kommen wir so besser zum Ziel.
Danke, PClaus

54.4k Fragen

233k Antworten

6k Nutzer

...