O Excel impede que a célula e seu conteúdo sejam excluídos (sem proteção de folha)

0

Eu tenho duas colunas na minha planilha do excel que quero proteger de uma maneira que você não possa excluir a célula nem seu conteúdo. Eu não quero usar o built-in proteção de folha, em vez disso eu quero usar o VBA (por causa de nenhuma senha necessária). Eu encontrei algum código que deve impedir que as células sejam excluídas, mas não funciona. Também não tenho ideia de como o VBA funciona e, portanto, ficaria feliz se alguém pudesse fornecer uma solução ou me orientar sobre como fazer isso sozinho.

O código que encontrei é este:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A6:B1048576")) Is Nothing Then Exit Sub
    On Error GoTo ExitPoint
    Application.EnableEvents = False
    If Not IsDate(Target(1)) Then
        Application.Undo
    End If
ExitPoint:
    Application.EnableEvents = True
End Sub
    
por XtremeBaumer 15.09.2017 / 15:03

1 resposta

1

Isso é semelhante ao código da sua pergunta, mas impede que qualquer célula nas colunas A: B seja excluída / definida como em branco:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Dim b As Boolean

    On Error GoTo Terminate

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    For Each c In Target.Cells
        If Not Intersect(c, Range("A:B")) Is Nothing And c.Value = "" Then
            b = True
            GoTo UndoChange
        End If
    Next c

UndoChange:
    If b Then Application.Undo

Terminate:
    If Err Then
        Debug.Print "Error", Err.Number, Err.Description
        Err.Clear
    End If

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Funciona com várias seleções de células, pois faz um loop em cada célula no intervalo alterado e verifica um valor em branco.

EDIT: Código modificado, para integrar sua funcionalidade Worksheet_Change existente;

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Dim b As Boolean

    On Error GoTo Terminate

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    For Each c In Target.Cells
        If Not Intersect(c, Range("A:B")) Is Nothing And c.Value = "" Then
            b = True
            GoTo UndoChange
        End If
        If c.Column = 10 And c.Row >= 6 Then
            c.Value = UCase(c.Value)
        End If
    Next c

UndoChange:
    If b Then Application.Undo

Terminate:
    If Err Then
        Debug.Print "Error", Err.Number, Err.Description
        Err.Clear
    End If

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
    
por 18.09.2017 / 10:29