Thema: Abfrage von Rechenaufgaben zeitgesteuert nach dem Zufallsprizip

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

Beiträge aus dem Excel-Forum zu den Themen Dialog und TextBox