Schiffe versenken automatisiert

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Label
Bild

Betrifft: Schiffe versenken automatisiert
von: Dennis
Geschrieben am: 10.08.2015 15:40:38

Hallo liebe Forum,
ich habe die letzten Tage Schiffe Versenken mit VBA programmiert. Eine Version, in der man gegen einen anderen Spieler spielt.
Jetzt möchte ich das ganze noch erweitern, sodass man gegen den PC spielen kann.
Hierzu stellt sich mir zunächst ein Grundproblem:
Das Schiffe setzen.
Ist es möglich, ein Makro zu schreiben, das in einem definierten Bereich per Zufall "Schiffe setzt"? Konkret: 5x X setzen, woanders 4x X (oder ein anderes Zeichen, dass die Schiffe kennzeichnet), etc.
Wie ich ein Feld per Zufall beschreiben könnte fällt mir ein, aber nicht, wie ich das zusammenhängend machen kann und ohne, dass das Schiff aus dem vorgegebenen Bereich fällt oder sich mit einem anderen Schiff überkreuzt.
Vielen Dank für eure Hilfe im Voraus.
Gruß,
Dennis

Bild

Betrifft: AW: Schiffe versenken automatisiert
von: ChrisL
Geschrieben am: 10.08.2015 19:02:39
Hi Dennis
Mein Ansatz wäre...
In einer Tabelle die Anzahl Schiffe und deren Länge definieren
(z.B. 2 1er, 3 2er, 2 3er, 1 5er)
1
1
2
2
2
3
3
5
Die Liste in einer For...Next Schleife abarbeiten.
Zufällig X, Y Position und Ausrichtung bestimmten.
Für jedes Setzen machst du einen Loop z.B.
For i = 1 To 8
Do Until CheckFrei(Laenge, XPosition, YPosition, Ausrichtung) = True
' neue Zufallszahlen
Loop
' Schiff Setzen
Next i
In der CheckFrei Funktion prüfst du, ob die Position frei ist. Wenn nicht, Loop geht weiter mit neuer Zufallszahl.
Ich hoffe der Beitrag gibt dir den nötigen Input zum Weitermachen.
cu
Chris

Bild

Betrifft: Schiffe automatisch setzen?
von: Dennis
Geschrieben am: 11.08.2015 08:06:55
Hallo Chris, hallo Forum,
schon einmal vielen Dank für die Hilfe!
So ganz klar ist es mir noch nicht. Vielleicht schilder ich meine Ausgangslage nochmal etwas genauer:
Das Spielfeld geht von A1 bis K10. Hier sollen folgende Schiffe untergebracht werden:
1 5er: XXXXXX
1 4er: XXXX
2 3er: XXX XXX
1 2er: XX
Die zufällige Koordinate würde ich mit

A = Int(10 * Rnd + 1) + 64 
Label1.Caption = Chr(A)

und
B = Int((10* Rnd) + 1)
bestimmen.
Mir ist noch nicht ganz klar, wie ich die Ausrichtung zufällig bestimmen kann und wie ich die For...Next Schleife dann konstruiere.
Vielen Dank für eure Hilfe!
Gruß, Dennis

Bild

Betrifft: Vorlage verstehen
von: Dennis
Geschrieben am: 11.08.2015 09:51:54
Nochmal hallo zusammen :)
Ich habe ein wenig gestöbert und bin hierbei auf das Spiel Schiffe Versenken gestoßen.
https://www.herber.de/bbs/user/1336.zip
Anmerkung: Das Spiel wurde von Ole P. Erlandsen programmiert.
In dieser Variante werden die Schiffe über folgenden Code gesetzt:

Private Sub FillBattleShips(TargetRange As Range)
Dim hPlacement As Boolean
    On Error Resume Next
    ActiveSheet.Unprotect
    On Error GoTo 0
    PlaceBattleShip 1, TargetRange
    PlaceBattleShip 2, TargetRange
    PlaceBattleShip 3, TargetRange
    PlaceBattleShip 4, TargetRange
    PlaceBattleShip 5, TargetRange
    ActiveSheet.Protect
End Sub

Private Sub PlaceBattleShip(ShipSize As Integer, TargetRange As Range)
Dim hPlacement As Boolean, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long
Dim OK As Boolean, ShipRange As Range, cl As Range
    OK = False
    Randomize
    hPlacement = Rnd * 100 < 50
    While Not OK
        X1 = Int(Rnd * TargetRange.Rows.Count) + 1
        Y1 = Int(Rnd * TargetRange.Columns.Count) + 1
        If hPlacement Then
            X2 = X1
            Y2 = Y1 + ShipSize - 1
        Else
            X2 = X1 + ShipSize - 1
            Y2 = Y1
        End If
        Set ShipRange = TargetRange.Range(Cells(X1, Y1), Cells(X2, Y2))
        If Application.CountA(ShipRange) = 0 Then
            OK = True
            For Each cl In ShipRange
                If Not CellInRange(cl, TargetRange) Then OK = False
            Next cl
            Set cl = Nothing
            If OK Then
                ShipRange.Formula = ShipChr
            End If
        End If
    Wend
    Set ShipRange = Nothing
End Sub

Ich würde gerne diese Vorlage für meine Version entsprechend anpassen, leider verstehe ich den Code nicht ganz.
Über den ersten Teil wird die Schiffslänge definiert. Was ist das für eine Funktion? Einfach ein Name und eine Zahl, da komm ich nicht ganz mit.
Im unteren Teil wird dann die Position bestimmt, aber auch hier ist mir unklar, wie das alles passiert.
Wenn sich einer von euch Experten diesen Teil anschauen könnte und mir etwas Licht im Dunklen entzünden könnte, wäre ich sehr dankbar! :)
Liebe Grüße,
Dennis

Bild

Betrifft: AW: Vorlage verstehen
von: Rudi Maintaire
Geschrieben am: 11.08.2015 13:43:16
Hallo,
PlaceBattleShip 1, TargetRange
ruft die untere Sub mit der Schiffslänge und dem Zielbereich (B4:K13 bzw M4:V13) auf.
Im 2.Teil hab ich mal ein bisschen rumgemacht.

Private Sub PlaceBattleShip(ShipSize As Integer, TargetRange As Range)
  '(Schiffsgröße, Spielfeld)
    Dim hPlacement As Boolean, X1 As Long, Y1 As Long
    Dim OK As Boolean, ShipRange As Range, cl As Range
    OK = False
    Randomize
    hPlacement = (Rnd * 100) < 50 'zufällige Ausrichtung waagerecht/ senkrecht
    Do While Not OK  'mach bis OK
        X1 = Int(Rnd * TargetRange.Rows.Count) + 1  'Startzeile
        Y1 = Int(Rnd * TargetRange.Columns.Count) + 1 'Startspalte
        If hPlacement Then
          'waagerecht, Bereich des Schffs
          Set ShipRange = TargetRange.Cells(X1, Y1).Resize(, ShipSize)
        Else
          'senkrecht, Bereich des Schffs
          Set ShipRange = TargetRange.Cells(X1, Y1).Resize(ShipSize)
        End If
        If Application.CountA(ShipRange) = 0 Then 'noch kein Schiff im Bereich
            OK = True
            'komplettes Schiff auf dem Spielfeld?
            For Each cl In ShipRange
                OK = OK And Not Intersect(cl, TargetRange) Is Nothing 'Then OK = False
            Next cl
            If OK Then
              'Schiff platzieren
                ShipRange = ShipChr
            End If
        End If
    Loop
    Set cl = Nothing
    Set ShipRange = Nothing
End Sub

Gruß
Rudi

Bild

Betrifft: AW: Vorlage verstehen
von: Dennis
Geschrieben am: 11.08.2015 15:19:46
Hallo Rudi,
danke dir für deine Erklärungen.
Der Code ist für mich als Neuling doch leider etwas kryptisch.

Private Sub FillBattleShips(TargetRange As Range)
Dim hPlacement As Boolean
    On Error Resume Next
    ActiveSheet.Unprotect
    On Error GoTo 0
    PlaceBattleShip 2, TargetRange
    PlaceBattleShip 3, TargetRange
    PlaceBattleShip 3, TargetRange
    PlaceBattleShip 4, TargetRange
    PlaceBattleShip 5, TargetRange
    ActiveSheet.Protect
End Sub
So würde ich den Teil definieren, damit er für meine Schiffe passt.
Doch wie gebe ich die TargetRange an?
falls ich die habe, kann ich dann den Teilcode an dem du gebastelt hast einfach übernehmen?
Vielen lieben Dank mal wieder für deine Hilfe Rudi,
Gruß Dennis

Bild

Betrifft: AW: Vorlage verstehen
von: Rudi Maintaire
Geschrieben am: 11.08.2015 15:48:49
Hallo,
Doch wie gebe ich die TargetRange an?
in deinem Fall

Sub aaa
FillBattleShips Range("A1:K10")
End Sub
In der Mappe wird FillBattleShips von der Prozedur CreateTheGameRange aufgerufen, die wiederum von StartNewGame aufgerufen wird.
Setz dir einen Haltepunkt an den Anfang von StartNewGame und geh alles mit F8 durch.
Gruß
Rudi

Bild

Betrifft: AW: Vorlage verstehen
von: ChrisL
Geschrieben am: 11.08.2015 16:13:47
Hi Dennis
Die anderen Codes habe ich nicht studiert, aber hier kurz meine Idee veranschaulicht:
https://www.herber.de/bbs/user/99495.xlsm
Sub SchiffeSetzen()
Dim i As Integer
Dim x As Integer, y As Integer, Ausrichtung As Integer, SchiffLaenge As Integer
Randomize
With Worksheets("Spiel")
.Range("Gitter").ClearContents
For i = 1 To 5
Do Until CheckFrei(x, y, Ausrichtung, SchiffLaenge) = True
x = Int(64 * Rnd + 1)
y = Int(64 * Rnd + 1)
Ausrichtung = Int(2 * Rnd + 1)
SchiffLaenge = Worksheets("Schiffe").Cells(i, 1)
Loop
If Ausrichtung = 1 Then
.Range(.Cells(x, y), .Cells(x + SchiffLaenge - 1, y)) = "x"
Else
.Range(.Cells(x, y), .Cells(x, y + SchiffLaenge - 1)) = "x"
End If
x = 0
Next i
End With
End Sub

Private Function CheckFrei(x, y, Ausrichtung, SchiffLaenge) As Boolean
Dim rng As Range
With Worksheets("Spiel")
    ' Erster Durchlauf noch keine Zufallszahl, darum Exit
    If x = 0 Then Exit Function
    
    ' Bereich für Schiff definieren
    If Ausrichtung = 1 Then
        Set rng = .Range(.Cells(x, y), .Cells(x + SchiffLaenge - 1, y))
        ' Prüfen, ob Schiff im Gitter liegt
        If x + SchiffLaenge > 64 Then Exit Function
    Else
        Set rng = .Range(.Cells(x, y), .Cells(x, y + SchiffLaenge - 1))
        ' Prüfen, ob Schiff im Gitter liegt
        If y + SchiffLaenge > 64 Then Exit Function
    End If
        
    ' Prüfen, ob es sich mit einem anderen Schiff überschneidet
    If WorksheetFunction.CountIf(rng, "x") > 0 Then Exit Function
End With
CheckFrei = True
End Function

cu
Chris

Bild

Betrifft: Danke Rudi und Chris! Abschließend...
von: Dennis
Geschrieben am: 12.08.2015 10:00:23
Hallo ihr zwei und vielen Dank für eure tolle Hilfe,
...habe ich noch eine Frage zum Code von Chris:
Wo wird denn der Bereich Range("Gitter") definiert? hab mich doof und dusselig gesucht, aber nichts gefunden :)
Den restlichen Code konnte ich schön an mein Dokument anpassen (auf den entsprechenden Bereich und mit einer Spielfläche 10x10 Felder) und es läuft super :)
Vielen Dank und einen schönen Tag euch,
Gruß Dennis

Bild

Betrifft: AW: Danke Rudi und Chris! Abschließend...
von: Rudi Maintaire
Geschrieben am: 12.08.2015 10:32:37
Hallo,
Wo wird denn der Bereich Range("Gitter") definiert?
gib dem Bereich einen Namen.
Gruß
Rudi

Bild

Betrifft: Danke Rudi und Chris! Abschließend...
von: Dennis
Geschrieben am: 12.08.2015 10:00:27
Hallo ihr zwei und vielen Dank für eure tolle Hilfe,
...habe ich noch eine Frage zum Code von Chris:
Wo wird denn der Bereich Range("Gitter") definiert? hab mich doof und dusselig gesucht, aber nichts gefunden :)
Den restlichen Code konnte ich schön an mein Dokument anpassen (auf den entsprechenden Bereich und mit einer Spielfläche 10x10 Felder) und es läuft super :)
Vielen Dank und einen schönen Tag euch,
Gruß Dennis

Bild

Betrifft: Danke Rudi und Chris! Abschließend...
von: Dennis
Geschrieben am: 12.08.2015 10:00:42
Hallo ihr zwei und vielen Dank für eure tolle Hilfe,
...habe ich noch eine Frage zum Code von Chris:
Wo wird denn der Bereich Range("Gitter") definiert? hab mich doof und dusselig gesucht, aber nichts gefunden :)
Den restlichen Code konnte ich schön an mein Dokument anpassen (auf den entsprechenden Bereich und mit einer Spielfläche 10x10 Felder) und es läuft super :)
Vielen Dank und einen schönen Tag euch,
Gruß Dennis

Bild

Betrifft: Danke Rudi und Chris! Abschließend...
von: Dennis
Geschrieben am: 12.08.2015 10:00:48
Hallo ihr zwei und vielen Dank für eure tolle Hilfe,
...habe ich noch eine Frage zum Code von Chris:
Wo wird denn der Bereich Range("Gitter") definiert? hab mich doof und dusselig gesucht, aber nichts gefunden :)
Den restlichen Code konnte ich schön an mein Dokument anpassen (auf den entsprechenden Bereich und mit einer Spielfläche 10x10 Felder) und es läuft super :)
Vielen Dank und einen schönen Tag euch,
Gruß Dennis

Bild

Betrifft: Sorry für 4fach Post...
von: Dennis
Geschrieben am: 12.08.2015 10:01:56
...nichts ist passiert, als ich ab "Absenden" gedrückt habe (dachte ich zumindest). Bitte entschuldigen^^

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Wert von Textbox begrenzen"