Hoja1 (BuscaMinas)

Private Sub CommandButton1_Click()

    Call Iniciar
    Sheets("BuscaMinas").Select

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim FilaX, ColumnaX As Integer

FilaX = ActiveCell.Row
ColumnaX = ActiveCell.Column

If FilaX < 11 Then
    If ColumnaX < 11 Then
        Sheets("Control").Range("N16").Offset(FilaX, ColumnaX) = 1
        If Sheets("Control").Range("N2").Offset(FilaX, ColumnaX) = 1 Then
            Selection.Interior.Color = vbRed
            Sheets("control").Range("AA2").Offset(FilaX, ColumnaX) = 1
            Sheets("control").Range("AL2").Offset(FilaX, ColumnaX) = 1
        End If
    End If
End If



End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

FilaX = ActiveCell.Row
ColumnaX = ActiveCell.Column

If ColumnaX < 11 Then
    If FilaX < 11 Then
        If Sheets("control").Range("N2").Offset(FilaX, ColumnaX) = 1 Then
            Selection.Interior.Color = vbGreen
            Sheets("control").Range("AL2").Offset(FilaX, ColumnaX) = 0
        Else
            Selection.Interior.Color = vbBlack
            Selection.Font.Color = vbWhite
            MsgBox "Error, vuelve a comenzar.", vbCritical, "Error"
            Application.ScreenUpdating = False
            For i = 1 To 11
                For j = 1 To 11
                    Cells(i, j).Select
                Next
            Next
            
        End If
    End If
End If

Cancel = True

End Sub

Modulo1

Sub Iniciar()

Application.ScreenUpdating = False
Application.EnableEvents = False

' Borra el relleno de la matriz de entrada
    
    Sheets("BuscaMinas").Select
    Range("A1:J10").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    Range("M2").Select

' Copia un nuevo mapa de Minas y borra matriz puntos usados, matriz minas detectadas y matriz minas erroneas

    Sheets("Control").Activate
    Range("B3:K12").Select
    Selection.Copy
    Range("O3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("O17:X26").Select
    Selection.ClearContents
    Range("AB3:AK12").Select
    Selection.ClearContents
    Range("AM3:AV12").Select
    Selection.ClearContents
    
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Categorías: Excel

Deja un comentario

Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *

Copy Protected by Chetan's WP-Copyprotect.