DÉMINEUR SOUS EXCEL

Dim mineX(15), mineY(15), Hdep, carre, etat
Sub efface()

For i = 1 To 10
    Rows(i).Value = ""
Next i

End Sub

Private Sub CommandButton1_Click()

etat = 1
carre = 0
Cells(7, 17) = carre
Hdep = Timer
Call efface

Randomize Timer
For i = 1 To 15
creat:
    Do: mineX(i) = Int(Rnd * 10): Loop Until mineX(i) <> 0
    Do: mineY(i) = Int(Rnd * 10): Loop Until mineY(i) <> 0
    For test = 1 To 15
        If mineX(test) = mineX(i) And mineY(test) = mineY(i) And i <> test Then GoTo creat
    Next test
Next i
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveCell.Row < 11 And ActiveCell.Column < 11 And etat = 1 Then

If ActiveCell.Value = "0" Then ActiveCell.Font.ColorIndex = 5
If ActiveCell.Value = "1" Then ActiveCell.Font.ColorIndex = 3
If ActiveCell.Value = "2" Then ActiveCell.Font.ColorIndex = 9

End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Row < 11 And ActiveCell.Column < 11 And etat = 1 Then



For i = 1 To 15
    If ActiveCell.Row = mineY(i) And ActiveCell.Column = mineX(i) Then GoTo perdue
Next i

carre = carre + 1
Cells(7, 17) = carre
If carre >= 85 Then GoTo gagne

ActiveCell.Value = compte(ActiveCell.Row, ActiveCell.Column)

GoTo fin
perdue:
etat = 0
Call affiche
MsgBox "Perdu ! "
GoTo fin
gagne:
temps = Int((Timer - Hdep) * 100) / 100
MsgBox "Bravo ! Gagné en " + CStr(temps) + " secondes"
fin:

End If
End Sub
Sub affiche()
For i2 = 1 To 15
    Cells(mineY(i2), mineX(i2)).Value = "+"
Next i2
End Sub

Function compte(Ligne, Colonne)
nb = 0
For i = 1 To 15
    If Ligne = mineY(i) And Colonne = mineX(i) + 1 Then nb = nb + 1
    If Ligne = mineY(i) And Colonne = mineX(i) - 1 Then nb = nb + 1
    If Ligne = mineY(i) + 1 And Colonne = mineX(i) Then nb = nb + 1
    If Ligne = mineY(i) + 1 And Colonne = mineX(i) + 1 Then nb = nb + 1
    If Ligne = mineY(i) + 1 And Colonne = mineX(i) - 1 Then nb = nb + 1
    If Ligne = mineY(i) - 1 And Colonne = mineX(i) Then nb = nb + 1
    If Ligne = mineY(i) - 1 And Colonne = mineX(i) + 1 Then nb = nb + 1
    If Ligne = mineY(i) - 1 And Colonne = mineX(i) - 1 Then nb = nb + 1
Next i
compte = nb
End Function





Sub CréationFeuille()
'
' CréationFeuille Macro
' Macro enregistrée le 16/08/2002 par mps
' Cette sub sert uniquement a créer la feuille

'
    Range("A1:J10").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("Q6").Select
    ActiveCell.FormulaR1C1 = "Cases parcourues :"
    Range("Q6:W6").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("T7").Select
    ActiveCell.FormulaR1C1 = "/ 85"
    Range("T7:W7").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("Q7:S7").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("Q6:W7").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Cells.Select
    Selection.ColumnWidth = 1.6
    Range("M1").Select
End Sub

Télécharger le zip