Le programme suivant permet de faire un démineur sur Excel.
Pour régénerer le démineur, faut pas oublier de rajouter un bouton (commandbutton1) sur la feuille.
Source / Exemple :
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
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.