Fly simulatoren (UserForm 1) er baseret på Excel VBA programmering.
John Walkenbach (2013):
Excel VBA Programming for Dummies,
Edition 3,
John Wiley & Sons
udlånes som e-bog gratis gennem
Ebook Central via bibliotekerne.
Hvad er ideen med projektet?
Man starter med at trykke "Press for a new flying" (eller ALT + P) og et øjebliksbillede af et fly dykker op som man skal respondere på ved at trykke for højderor op (ALT + u) for det aktuelle billede.
Der er pt 12 øjebliksbilleder blandt 100 flyvninger (de 12 billeder fordeles tilfældigt blandt de 100).
Det tilhørende regneark er vist til venstre og funktionen er at opsummere data fra flyvningerne. For eksempel udregnes reaktionstiden for hver flyvning samt gennmsnittet.
De grønne felter angiver det valgte ror, og de gule felter er det rigtige ror.
I det følgende beskrives VBA rutinerne. Til venstre ses at vi har modulerne 1, 2, 3 og 5 samt UserForm 1. Forinden ser vi på register oversigt.
Hvor | Funktion | Enhed | Bemærkning |
Sheet Panel | |||
J2 | Angivelse af ror | Sand/falsk | |
R8 | Begyndelse af billede | Tid | |
R9 | Slut af billede | Tid | = Q12 |
M5 | Antal flyvninger | Heltal | |
R15 | Akkumuleret tid | Tid | |
Reaktion | Bemærkning | ||
Mode | |||
B5 | Øverste venstre hjørne af billede | ||
Ror | |||
TVHR | |||
THHL | |||
aabc | |||
babc | |||
TVKR | |||
THKR | |||
Sheet Motor | |||
D9 | Udvalgt billede | ||
Modul 1, startes med CTRL+SHIFT+P
Sub main()
' nulstilling af relevante registre
x = Now()
Range("R8").Value = x
Range("R9").Value = x
Range("R15").Value = 0
Range("M5").Value = 0
n = 0
m = 0
' start up af userform. Venter i Userform på en event (click) OG vender tilbage
' her hvis click rutine indeholder unload userform1.
UserForm1.Show
' Yderligere nulstilling
Range("mode").Value = ""
Range("Reaktion").Value = ""
End Sub
Modul 2
Sub billede()
'
' billede Makro
'
' references:
' https://exceloffthegrid.com/vba-code-to-insert-move-delete-and-control-pictures/
'
Dim vindue
Dim present
Dim myImage As Shape
' slette det gamle billede
Sheets("Panel").Select
' find picture if present and delete it
present = ActiveSheet.Shapes.Count
If present <> 0 Then
Set myImage = ActiveSheet.Shapes(present)
' MsgBox myImage.Name
myImage.Delete
End If
' finde det nye billede, placere og nedskalere det og paste
Sheets("Motor").Select
' find actual window and insert it
vindue = Range("D9").Value
ActiveSheet.Shapes.Range(Array(vindue)).Select
Selection.Copy
Sheets("Panel").Select
Range("B5").Select
Application.ScreenUpdating = False
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 0.6, msoFalse, msoScaleFromTopLeft
Application.ScreenUpdating = True
End Sub
Modul 3
Sub UpdatingRor()
'Finde sluttidspunktet og akkumulere tid for beregning af reaktionstid
x = Now()
Range("R9").Value = x
Range("R15").Value = Range("R12").Value + Range("R15").Value
' indbygge tidsforsinkelse så man kan se kontrol sættes
Range("Reaktion").Value = "tak for svar"
Application.Wait (Now + TimeValue("0:00:02"))
If Range("J2").Value = False Then Call ErrorHandling(n)
End Sub
Modul 5
Public m
Sub ErrorHandling(n)
'
' column A is flying number, begining with row 5
' column B is picture number, beginning with row 5
' column C is ...
Sheets("Panel").Select
Flynum = Range("M5").Value
Pictnum = Range("Q16").Value
Range("J12:O13").Select
Selection.Copy
Sheets("Fejl").Select
Range("A7").Offset(3 * m, 0).Value = Flynum
Range("B7").Offset(3 * m, 0).Value = Pictnum
Range("C7").Offset(3 * m, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
m = m + 1
Sheets("Panel").Select
End Sub
UserForm 1
Private Sub CommandButton1_Click() 'Stop knappen
Unload UserForm1
Range("Reaktion").Value = "bye-bye"
Range("TVHR").Value = ""
Range("THHR").Value = ""
Range("aabc").Value = ""
Range("babc").Value = ""
Range("TVKR").Value = ""
Range("THKR").Value = ""
' Fjerner kommentar efter 5 sek
Application.Wait (Now + TimeValue("0:00:05"))
Range("Reaktion").Value = ""
End Sub
Private Sub Label1_Click()
End Sub
Private Sub OptionButton1_Click()
Mode = OptionButton1.Value 'F knappen
Range("TVHR").Value = Mode
Call UpdatingRor
OptionButton1.Value = False
End Sub
Private Sub OptionButton2_Click()
Mode = OptionButton2.Value 'G knappen
Range("THHR").Value = Mode
Call UpdatingRor
OptionButton2.Value = False
End Sub
Private Sub OptionButton3_Click() 'N knappen
Mode = OptionButton3.Value
Range("aabc").Value = Mode
Call UpdatingRor
OptionButton3.Value = False
End Sub
Private Sub OptionButton4_Click() ' U knappen
Mode = OptionButton4.Value
Range("babc").Value = Mode
Call UpdatingRor
OptionButton4.Value = False
End Sub
Private Sub OptionButton5_Click() 'H knappen
Mode = OptionButton5.Value
Range("TVKR").Value = Mode
Call UpdatingRor
OptionButton5.Value = False
End Sub
Private Sub OptionButton6_Click() 'J knappen
Mode = OptionButton6.Value
Range("THKR").Value = Mode
Call UpdatingRor
OptionButton6.Value = False
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub ToggleButton1_Click() 'Press for a new flying
Mode = ToggleButton1.Value
'true if pressed down, false if pressed up
n = Range("M5").Value
If Mode = True Then Range("Reaktion").Value = "flying..."
' Hvis mode = falsk skal vi ikke flyve men finde airpalne correction
If Mode = False Then GoTo slut
n = n + 1
If (n + 1) > 101 Then GoTo slut
Range("M5").Value = n
Call billede
' sletter billede efter 2 sek præsentation
Application.Wait (Now + TimeValue("0:00:02"))
Selection.Delete
' Noterer begyndelsestidspunktet
Range("Reaktion").Value = "Please indicate the airplane correcction"
x = Now()
Range("R8").Value = x
slut:
ToggleButton1.Value = False
Range("TVHR").Value = ""
Range("THHR").Value = ""
Range("aabc").Value = ""
Range("babc").Value = ""
Range("TVKR").Value = ""
Range("THKR").Value = ""
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub userform1_initialize()
End Sub