# MineSweeper in VBA - Aufdeckmechanismus



## Quanaarinail.com (11. Juni 2019)

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


----------



## vfl_freak (11. Juni 2019)

Moin,


Quanaarinail.com hat gesagt.:


> 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


Poste besser den (relevanten) Code (Code-Tags beachten)!
Dass läßt sich zitieren und ALLE, die dies lesen, wissen worum es eigentlich geht!!
VG Klaus


----------



## Quanaarinail.com (11. Juni 2019)

vfl_freak hat gesagt.:


> Moin,
> 
> Poste besser den (relevanten) Code (Code-Tags beachten)!
> Dass läßt sich zitieren und ALLE, die dies lesen, wissen worum es eigentlich geht!!
> VG Klaus



Danke für dein Feedback.
Das Problem ist, das ich bezüglich des genannten Problems noch nichts geschrieben habe.


----------



## Quanaarinail.com (11. Juni 2019)

```
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
```


----------



## Quanaarinail.com (11. Juni 2019)

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.


----------



## Yaslaw (11. Juni 2019)

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.


----------



## Quanaarinail.com (11. Juni 2019)

Yaslaw hat gesagt.:


> 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.


----------



## vfl_freak (11. Juni 2019)

Quanaarinail.com hat gesagt.:


> da er, wenn `iZahl <> iZahl + 1` direkt ne 0 hinmacht.


Bitte was??
WO ist denn die Prüfung (mal davon abgesehen, das 'iZahl' IMMER ungleich 'iZahl + 1' wäre) ?
Und WO man er was hin ??

VG Klaus


----------



## Quanaarinail.com (11. Juni 2019)

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`


----------



## Quanaarinail.com (11. Juni 2019)

Quanaarinail.com hat gesagt.:


> 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
> ...



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


----------



## Quanaarinail.com (11. Juni 2019)

Yaslaw hat gesagt.:


> 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.



Warte, meinst du so etwas wie " Wenn eine 0 im Feld steht, mach nichts"?


----------



## Yaslaw (11. Juni 2019)

Quanaarinail.com hat gesagt.:


> Warte, meinst du so etwas wie " Wenn eine 0 im Feld steht, mach nichts"?


Genau, dann ist das Feld bereits aufgdeckt.


----------



## Quanaarinail.com (11. Juni 2019)

Yaslaw hat gesagt.:


> Genau, dann ist das Feld bereits aufgdeckt.



Das ist ja der Plan, dass er das für alle umliegenden Felder ebenfalls macht. bisher fügt er - wie gesagt - bei Klicken eines leeren Feldes, wo auch kein x in der unmittelbaren Nähe ist, direkt eine 0 hinzu, da er andernfalls eine 1 (bei einem x im 1er Radius) bzw. eine 2 (bei 2 x im 1er Radius) usw. schreibt. Das ist ja die beschriebene Function "Umfeldcheck". So hab ich es zumindest verstanden, und das funktioniert soweit ja auch. 

Ich hoffe, wir reden hier gerade nicht aneinander vorbei.


----------



## Quanaarinail.com (11. Juni 2019)

Quanaarinail.com hat gesagt.:


> Das ist ja der Plan, dass er das für alle umliegenden Felder ebenfalls macht. bisher fügt er - wie gesagt - bei Klicken eines leeren Feldes, wo auch kein x in der unmittelbaren Nähe ist, direkt eine 0 hinzu, da er andernfalls eine 1 (bei einem x im 1er Radius) bzw. eine 2 (bei 2 x im 1er Radius) usw. schreibt. Das ist ja die beschriebene Function "Umfeldcheck". So hab ich es zumindest verstanden, und das funktioniert soweit ja auch.
> 
> Ich hoffe, wir reden hier gerade nicht aneinander vorbei.



Mir fällt gerade auf, dass ich das Wort "ja" ziemlich inflationär benutze. Muss ich ändern, sieht komisch aus.


----------



## Quanaarinail.com (11. Juni 2019)

Quanaarinail.com hat gesagt.:


> 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



Der Teil des Codes ist übrigens zu vernachlässigen, hab ich gerade bemerkt.


----------



## Yaslaw (11. Juni 2019)

Du gehst sehr Statisch ans Werk. Rekursiv ist einfacher.

1) Also, du prüfst das aktive Feld. Wenn es eine Mine ist - Boom, fertig.
2) Ermittle die Minen rundherum und trag die Zahl ein.
3) Wenn 0, rufe für alle acht benachbarten Felder Punkt 2 auf.

Damit finden sich die anderen leeren Felder von alleine.


----------



## Quanaarinail.com (12. Juni 2019)

Sobald ich herausgefunden habe, wie ich deine Worte in Code umwandeln kann, versuche ich das. Danke vielmals jedenfalls.


----------

