Gruppe
Dialog
Bereich
TextBox
Thema
Abfrage von Rechenaufgaben zeitgesteuert nach dem Zufallsprizip
Problem
Wie kann ich zeitgesteuert Rechenaufgaben abfragen. Die Basiszahlen und die Operanden sollen durch das Zufallsprinzip bestimmt und die Ergebnisse sollen ausgewertet werden.
Lösung
Geben Sie den nachfolgenden Code in das Klassenmodul der UserForm ein.
StandardModule: basMain
Public NextTime As Date
Sub CallForm()
frmRechnen.Show
End Sub
Sub Verbergen()
Worksheets("Memory").Visible = xlVeryHidden
End Sub
Sub NeueAufgabe()
Dim vOperand As Variant
Dim iOperand As Integer, iFactorA As Integer, iFactorB As Integer
Dim iRowL As Integer
Dim sOperand As String
Randomize
vOperand = Array("+", "-", "*", "/")
iOperand = Int((4 * Rnd) + 0)
sOperand = vOperand(iOperand)
iFactorA = Int((99 * Rnd) + 1)
iFactorB = Int((9 * Rnd) + 1)
frmRechnen.lblAufgabe.Caption = iFactorA & " " & sOperand & " " & iFactorB
Worksheets("Memory").Range("AA1").Formula = "=" & frmRechnen.lblAufgabe.Caption
NextTime = Now + TimeSerial(0, 0, frmRechnen.SpinButton1.Value)
Application.OnTime _
earliesttime:=NextTime, _
procedure:="NeueAufgabe"
End Sub
Sub RechnenBeenden()
On Error GoTo ERRORHANDLER
Application.OnTime _
earliesttime:=NextTime, _
procedure:="NeueAufgabe", _
schedule:=False
ERRORHANDLER:
With Worksheets("Memory")
If WorksheetFunction.CountA(.Columns(1)) = 0 Then Exit Sub
MsgBox "Von " & WorksheetFunction.CountA(.Columns(1)) & _
" Aufgaben wurden " & WorksheetFunction.Sum(.Columns(1)) & _
" richtig gelöst." & vbLf & _
"Dies entspricht " & Format(WorksheetFunction.Sum(.Columns(1)) / _
WorksheetFunction.CountA(.Columns(1)), "0.0%")
.Columns(1).ClearContents
End With
End Sub
ClassModule: frmRechnen
Private Sub cmdContinue_Click()
Unload Me
Call RechnenBeenden
End Sub
Private Sub cmdLoesung_Click()
Dim iRow As Integer
If txtLoesung.Text = "" Then Exit Sub
With Worksheets("Memory")
iRow = WorksheetFunction.CountA(.Columns(1)) + 1
If CDbl(txtLoesung.Text) = .Range("AA1").Value Then
.Cells(iRow, 1).Value = 1
Else
.Cells(iRow, 1).Value = 0
End If
End With
txtLoesung.Text = ""
txtLoesung.SetFocus
End Sub
Private Sub cmdStart_Click()
Call NeueAufgabe
End Sub
Private Sub SpinButton1_Change()
Label4.Caption = SpinButton1.Value & " sec."
End Sub
Private Sub UserForm_Initialize()
SpinButton1.Value = 10
End Sub