none
VBA EM EXCEL RRS feed

  • Pergunta

  • Bom dia!

    Estou usando o código abaixo em uma planilha para proteger células que já est]ao preenchidas com valores ou fórmulas e também proteger as células que acabaram de ser preenchidas com valores. Entretanto o código só está protegendo as células que contém fórmulas e deixa as células com valores desbloqueadas.

    Como posso fazer para proteger também as células que já contém valores bem como as que ainda serão preenchidas.

    O objetivo é proteger as células já preenchidas com fórmulas e valores bem como as células onde serão inseridos valores. 


    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    ActiveSheet.Unprotect Password:="manaus"
    Cells.Locked = False
    On Error Resume Next
    Set rng = Cells.SpecialCells(xlCellTypeFormulas)
    If Err.Number > 0 Then
    Set rng = Cells.SpecialCells(xlCellTypeConstants)
    Else
    Set rng = Union(rng, Cells.SpecialCells(xlCellTypeFormulas))
    End If
    On Error GoTo 0
    If Not rng Is Nothing Then rng.Locked = True
    ActiveSheet.Protect Password:="manaus"

    End Sub

    Grato a quem puder ajudar.

    Hamilton.

    domingo, 15 de janeiro de 2017 15:51

Respostas

  • Boa noite Hamilton.

    Perceba, em:

    On Error Resume Next
    Set rng = Cells.SpecialCells(xlCellTypeFormulas)
    If Err.Number > 0 Then
        Set rng = Cells.SpecialCells(xlCellTypeConstants)   '<----
    Else
        Set rng = Union(rng, Cells.SpecialCells(xlCellTypeFormulas))
    End If

    a parte marcada somente será executada se a planilha Não tiver fórmulas, ou seja, se gerar erro no primeiro 'Set'. Caso não haja erro, você está fazendo a união de duas coisas iguais, ou seja, de apenas fórmulas.

    Uma possível solução seria realizar apenas uma troca:

    Set Rng = Union(Rng, Cells.SpecialCells(xlCellTypeConstants))
    Abraço.


    Filipe Magno

    • Marcado como Resposta Barbosah segunda-feira, 16 de janeiro de 2017 14:34
    segunda-feira, 16 de janeiro de 2017 01:53

Todas as Respostas

  • Boa noite Hamilton.

    Perceba, em:

    On Error Resume Next
    Set rng = Cells.SpecialCells(xlCellTypeFormulas)
    If Err.Number > 0 Then
        Set rng = Cells.SpecialCells(xlCellTypeConstants)   '<----
    Else
        Set rng = Union(rng, Cells.SpecialCells(xlCellTypeFormulas))
    End If

    a parte marcada somente será executada se a planilha Não tiver fórmulas, ou seja, se gerar erro no primeiro 'Set'. Caso não haja erro, você está fazendo a união de duas coisas iguais, ou seja, de apenas fórmulas.

    Uma possível solução seria realizar apenas uma troca:

    Set Rng = Union(Rng, Cells.SpecialCells(xlCellTypeConstants))
    Abraço.


    Filipe Magno

    • Marcado como Resposta Barbosah segunda-feira, 16 de janeiro de 2017 14:34
    segunda-feira, 16 de janeiro de 2017 01:53
  • Filipe, bom dia!

    A alteração funcionou perfeitamente.

    Grato pela ajuda.

    Hamilton.

    segunda-feira, 16 de janeiro de 2017 14:33