Zufallszahlen, Froschhüpfen

Ein kleines Beispiel, wie man Zufallszahlen erzeugt Damit werden Frösche von einem Seerosenblatt zu einem befördert (und zurück). Es wird gestoppt, wenn alle Frösche auf dem rechten Blatt sind.

Beispieldatei frosch.zip 41 KB)

'Vorraussetzung:
'Ein Tabellenblatt mit Namen Frosch
'Darauf 3 Buttons mit Namen
'cmbAbbrechen
'cmbStart
'cmbZurück
'Zwei Bilder mit einem Seerosenblatt, das eine liegt über
'dem Bereich A11:F23. Das andere über dem Bereich G11:L23
'Sechs Frösche mit den Namen Frosch1 bis Frosch6, die über
'den Bildern der Seerosenblätter liegen.
'In die Zelle F1 den Zeitabstand zwischen den Würfen.

'In das Klassenmodul des Tabellenblatts folgende Ereignisprozeduren

Private Sub cmbAbbrechen_Click()
    Beenden = True
End Sub

Private Sub cmbStart_Click()
    If Now < (Timewait + TimeSerial(0, 0, 1)) Then _
        Beenden = True: Exit Sub
    Beenden = False
    zurücksetzen
    Range("F3") = Now
    'Zeit abwarten und dann starten
    ' Application.OnTime Now + _
        TimeSerial(0, 0, .Range("F1")), _
        "WürfelnUndWechseln"
    'gleich starten
    WürfelnUndWechseln
End Sub

Private Sub cmbZurück_Click()
    zurücksetzen
End Sub


'In ein Modul

Public Beenden As Boolean, Timewait As Date
Public Sub WürfelnUndWechseln()
Dim Würfelergebnis As Long, Zeit As Date
With Sheets("Frosch")
If Beenden = False Then
    Zeit = TimeSerial(0, 0, .Range("F1"))
    Würfelergebnis = Int((6 * Rnd) + 1)
    .Range("F2") = Würfelergebnis
    .Range("F4") = Now
    .Shapes("Frosch" & Würfelergebnis).Left = _
        .Cells(20, (.Shapes("Frosch" & Würfelergebnis).Left < _
        .Cells(20, 7).Left) * (-6) + Würfelergebnis).Left
    If Not AlleRechts Then
        Timewait = Now + Zeit
        Application.OnTime Timewait, "WürfelnUndWechseln"
    End If
End If
End With
End Sub

Private Function AlleRechts() As Boolean
Dim i As Long
With Sheets("Frosch")
    For i = 1 To 6
        AlleRechts = .Shapes("Frosch" & i).Left >
            .Cells(20, 6).Left
        If Not AlleRechts Then Exit For
    Next
End With
End Function

Public Sub zurücksetzen()
Dim i As Long
Beenden = False
Randomize
With Sheets("Frosch")
    For i = 1 To 6
        .Shapes("Frosch" & i).Left =
            .Cells(20, i).Left
        .Shapes("Frosch" & i).Top =
            .Cells(20, i).Top
    Next
End With
End Sub