MineSweeper in VBA - Aufdeckmechanismus

Quanaarinail.com

Grünschnabel
Moin, liebe Leute.

Willkommen auf meinem ersten Thread in diesem Forum. Ich hab hier schon den einen oder anderen Thread zum Thema VBA-MineSweeper gesehen, aber leider beschreibt keiner von diesen mein Problem.

Also: Ich mache gerade ein Praktikum im IT-Bereich, um herauszufinden, ob mir die Branche liegt. Im Rahmen eben dieses Praktikums habe ich die Aufgabe bekommen, Minesweeper mit VBA zu proggen. Bin da auch schon relativ weit, mir fehlt eigentlich nur noch eine Idee, wie ich leere Felder im Umfeld einer aktiven Zelle automatisch aufdecke, damit ich nicht wie blöde im Spielfeld herumstochern muss.

Hatte da an eine Schleife gedacht, die im Umfeld der aktiven Zelle nach einem x (x ist hier die Mine, die ich nicht anklicken darf) sucht, und falls weder die aktive Zelle noch die Zellen im 1er Umfeld ein solches x enthalten, soll er jeweils in alle Richtungen weitergehen, bis er ein x da stehen hat.

Nun zu meiner Frage: Wie kann ich das machen, ohne da ne Endlosschleife zu erschaffen und so weiter?

Danke schonmal im Voraus.

Have a nice day,

Yours, Quanaarin!

P.S.: Ich würde gerne die aktuelle Version dranhängen, damit ihr seht, wo ich stehe, aber die Seite sagt mir, die hochgeladene Datei habe keine erlaubte Erweiterung.


Tante Edit: Code siehe unten
 
Zuletzt bearbeitet:
Visual Basic:
Public iPlus As Integer
Public iZüge As Integer
Public iTreffer As Integer



Public Function Check()

iPlus = 4
For y = 0 To 10
    For i = 0 To 10
    If Cells(y + iPlus, i + iPlus) = "x" Then
        Cells(y + iPlus, i + iPlus) = "y"
        Cells(y + iPlus, i + iPlus).Interior.ColorIndex = 3
    End If
    Next
Next

End Function




Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rowindex
Dim Columnindex
Dim upperbound
Dim lowerbound
Dim iWert As Integer
upperbound = 14
lowerbound = 1
rowindex = ActiveCell.Row
Columnindex = ActiveCell.Column
    If ActiveCell.Value = "x" Then                                          ' "wenn aktive Zelle "x" enthält, dann"
        'iWert = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)      '
        'Cells(rowindex, Columnindex) = "y"                                 '
        Cells(rowindex, Columnindex).Interior.ColorIndex = 3                ' "ändere Füllfarbe der aktiven Zelle in 3 (rot)"
        Cells(rowindex, Columnindex).Font.ColorIndex = 3                    ' "ändere Schriftfarbe der aktiven Zelle in 3 (rot)"
        
        MsgBox ":c BOOM! Game Over! Try again. c:"                                        ' "öffne ein Textfeld, mit den Worten 'BOOM! Game Over! :c'"
    Else
        If rowindex >= 5 And rowindex <= 14 And Columnindex >= 5 And Columnindex <= 14 Then 'Feldbegrenzung ("wenn Zeilenindex der aktiven Zelle größer gleich 5 und kleiner gleich 14 und Spaltenindex größer gleich 5 und kleiner gleich 14, dann")
        
            iWert = Umfeldcheck(rowindex, Columnindex)                                      ' "Führe Funktion "Umfeldcheck" aus"
            Cells(rowindex, Columnindex).Interior.ColorIndex = 14                           ' "ändere Füllfarbe der aktiven Zelle in 14 (türkis)"
            
            iZüge = iZüge + 1                                                               ' Counter "addiere der Variable "iZüge" einen Zähler hinzu"
            Cells(rowindex, Columnindex) = iWert
        End If
    End If
    Cells(9, 22) = iZüge                                                 ' "(zeile 9, Spalte 22) betrifft Variable "iTreffer"."
                                              
    
End Sub

Sub Schaltfläche1_Klicken()
Range("Spielflaeche").Interior.ColorIndex = 0

Dim rowindex
Dim Columnindex
Dim upperbound
Dim lowerbound
Dim iWertRow As Integer
Dim iWertCol As Integer
upperbound = 14
lowerbound = 5
iPlus = 4
For y = 1 To 10
    For i = 1 To 10
        Cells(y + iPlus, i + iPlus) = " "
        Cells(y + iPlus, i + iPlus).Interior.ColorIndex = 0
        Cells(y + iPlus, i + iPlus).Font.ColorIndex = 1
        
        
        '0 = ohne Farbe; 1 = schwarz; 2 = weiß; 3 = rot; 4 = grün; 5 = blau; 6 = gelb; 7 = Magenta, 8 = Cyan
        
    Next
Next
For y = 0 To 10 'du
    'For i = 0 To 10
    iWertRow = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
    iWertCol = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
    Cells(iWertRow, iWertCol) = "x"


    'Next
Next
    Cells(9, 22) = 0
    iZüge = 0
    
End Sub


Public Function Umfeldcheck(r, c)
    Dim iZahl
    Dim iFarbe
        
    

        If Cells(r, c + 1) = "x" Then       ' "Wenn Zelle (Zeile + 0, Spalte + 1) "x" enthält, dann
        iZahl = iZahl + 1                   ' "addiere der Variable 'iZahl' einen Zähler hinzu"
        Cells(r, c).Font.ColorIndex = 1     ' "ändere Schriftfarbe der Zelle in 1 (schwarz)
      
    
        
    End If
        If Cells(r + 1, c + 1) = "x" Then
        iZahl = iZahl + 1
        Cells(r, c).Font.ColorIndex = 1
        
        
    End If
        If Cells(r + 1, c) = "x" Then
        iZahl = iZahl + 1
        Cells(r, c).Font.ColorIndex = 1
        
        
    End If
        If Cells(r + 1, c - 1) = "x" Then
        iZahl = iZahl + 1
        Cells(r, c).Font.ColorIndex = 1
      
    End If
        If Cells(r, c - 1) = "x" Then
        iZahl = iZahl + 1
        Cells(r, c).Font.ColorIndex = 1
        
    End If
        If Cells(r - 1, c) = "x" Then
        iZahl = iZahl + 1
        Cells(r, c).Font.ColorIndex = 1
        
    End If
        If Cells(r - 1, c - 1) = "x" Then
        iZahl = iZahl + 1
        Cells(r, c).Font.ColorIndex = 1
        
    End If
        If Cells(r - 1, c + 1) = "x" Then
        iZahl = iZahl + 1
        Cells(r, c).Font.ColorIndex = 1
      
    End If
    
        
        
    
    Umfeldcheck = iZahl
End Function
 
P.S.: Bemerke: Ich bin noch ziemlich grün hinter den Ohren, was das programmieren angeht, daher seid bitte zärtlich. Selbst für mich sieht dieser Code ziemlich umständlich aus. :D
 
Ich würde bei den Leeren Feldern beim Aufdecken dann eine 0 hinenschreiben und die Schriftfarbe auf weiss stellen.
Somit kannst du am Anfang prüfen, ob das Feld bereits aufgedeckt wurde.
 
Ich würde bei den Leeren Feldern beim Aufdecken dann eine 0 hinenschreiben und die Schriftfarbe auf weiss stellen.
Somit kannst du am Anfang prüfen, ob das Feld bereits aufgedeckt wurde.

Danke erstmal für die Antwort.
Die Null kommt wegen Public Function Umfeldcheck(r, c) schon automatisch, da er, wenn iZahl <> iZahl + 1 direkt ne 0 hinmacht. :)
 
Uii, sry falls ich unverständlich schreibe. Bin wie gesagt noch gänzlich neu auf dem Gebiet. Ich will sagen, dass er automatisch eine 0 setzt, wenn er weder ein x direkt in der aktiven Zelle noch im 1er Radius stehen hat.

siehe:
If Cells(r + 1, c - 1) = "x" Then iZahl = iZahl + 1 Cells(r, c).Font.ColorIndex = 1 End If
 
Uii, sry falls ich unverständlich schreibe. Bin wie gesagt noch gänzlich neu auf dem Gebiet. Ich will sagen, dass er automatisch eine 0 setzt, wenn er weder ein x direkt in der aktiven Zelle noch im 1er Radius stehen hat.

siehe:
If Cells(r + 1, c - 1) = "x" Then iZahl = iZahl + 1 Cells(r, c).Font.ColorIndex = 1 End If

P.S.: Die 0 setzt er dann folglich in die aktive (angeklickte) Zelle.
 
Zurück