Schiffe versenken automatisiert

Dennis · 2015-08-10T15:40:38+00:00

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

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

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

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

Forumthread: Schiffe versenken automatisiert

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial