3

Eu tenho uma tabela em excel com uma linha apenas (mais o cabeçalho) e seis colunas. Toda a folha está protegida exceto essa linha.

No final da tabela eu queria ter um botão (+) que adiciona uma nova linha, e um botão (-) que remove a última linha da tabela, exceto se for a linha original (esta nunca pode ser removida).

Como poderei fazer isto?

3
  • Inserir é possível, mas remover nos teste que fiz não foi possível devido a planilha está protegida. Commented 13/06/2014 às 2:09
  • 1
    E se verificarmos se ela é a linha "principal" primeiro? Aí depois a cada adição e subtração de linha ele desprotege antes, e protege novamente quando termina a ação.
    – Matt S
    Commented 18/06/2014 às 11:44
  • 1
    O caminho é o que o @Strokes sugeriu: desproteger a planilha, fazer a alteração, e protegê-la novamente. Fiz uma resposta com uma sugestão de solução com essa ideia. Commented 3/07/2014 às 18:51

1 Resposta 1

3

Crédito da ideia original de desbloquear, alterar e bloquear ao usuário @Strokes.

O que você pode fazer é manter a folha protegida e no código do botão utilizar a seguinte ordem:

  • Desproteja a folha usando a senha desejada
  • Insira (ou remova) uma linha
  • Reposicione os botões*
  • Volte a proteger a folha usando a mesma senha

O único "problema" dessa abordagem é que você precisa definir a senha para proteção diretamente no código, e assim qualquer pessoa com algum conhecimento (suficiente pra utilizar o atalho ALT+F11) irá facilmente encontrá-la. Mas, provavelmente isso vai ser suficiente para a sua necessidade.

*No exemplo abaixo eu fiz uma sub pra reposicionar os botões, mas ela é desnecessária porque o código de inserção e remoção de linhas utiliza o próprio recurso de shift de linhas do Excel, que já posiciona corretamente o conteúdo abaixo da tabela. Assim, serve apenas como referência de como fazer (e também porque quando eu inseri os botões eu não os posicionei manualmente pra ficarem do jeito que estão).

Abaixo eu compartilho o código de exemplo que gerencia a tabela da forma como ilustrada abaixo:

inserir a descrição da imagem aqui

Esse código usa a cor branca para diferenciar as linhas que fazem parte da tabela, considera como fixas as colunas de 1 a 6, como fixa a linha inicial em 2 e como fixos os nomes dos botões em AddBtn e RemoveBtn (que respectivamente chamam as subs AddRow e RemoveRow). O código também procura manter a formatação, seleção atual e conteúdo do usuário ao redor da tabela conforme linhas são inseridas e/ou removidas.

A planilha de exemplo pode ser baixada do 4Shared. Eis o código:

' Função para contagem do número de linhas existentes.
' Conta aquelas que têm o fundo branco.
Private Function getRowCount()

    Dim i As Integer
    Dim iCount As Integer

    i = 2
    iCount = 0
    While i <= 1048576 And Cells(i, 1).Interior.Color = vbWhite
        i = i + 1
        iCount = iCount + 1
    Wend

    getRowCount = iCount

End Function

' Sub para proteger a planilha, destravando apenas as células das linhas existentes na tabela
Private Sub ProtectSheet()

    ' Trava todas as células
    Cells.Select
    Selection.Locked = True
    Selection.FormulaHidden = True

    ' Destrava apenas as células das linhas na tabela
    With Range(Cells(2, 1), Cells(getRowCount() + 1, 6))
        .Locked = False
        .FormulaHidden = False
    End With

    ' Protege a folha atual
    ActiveSheet.Protect Password:="Teste-SOPT", DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

' Sub para desproteger a planilha
Private Sub UnprotectSheet()

    ' Desprotege a folha atual
    ActiveSheet.Unprotect Password:="Teste-SOPT"

End Sub

' Sub pra posicionar os botões na célula da linha e coluna dadas
Private Sub PositionButtons(ByVal iRow As Integer, ByVal iColumn As Integer)

    Dim oRange As Range
    Dim oAddBtn As Variant
    Dim oRemoveBtn As Variant

    Set oAddBtn = ActiveSheet.Buttons("AddBtn")
    Set oRemoveBtn = ActiveSheet.Buttons("RemoveBtn")

    Set oRange = ActiveSheet.Cells(iRow, iColumn)

    With oAddBtn
        .Top = oRange.Top
        .Left = oRange.Left
        .Height = oRange.Height
        .Width = oRange.Width / 2
    End With

    With oRemoveBtn
        .Top = oRange.Top
        .Left = oRange.Left + (oRange.Width / 2)
        .Height = oRange.Height
        .Width = oRange.Width / 2
    End With

End Sub

' Sub do botão "+" para adicionar uma nova linha
Public Sub AddRow()

    On Error Resume Next

    Dim iLastRow As Integer
    Dim oSave As Range

    ' Salva a seleção atual
    Set oSave = Selection

    ' Desliga a atualização da tela temporariamente
    Application.ScreenUpdating = False

    ' Desprotege a folha atual
    UnprotectSheet

    ' Pega o número da última linha
    iLastRow = getRowCount() + 1 ' Soma 1 porque a contagem começa na linha 2

    ' Insere uma nova linha abaixo da última
    Rows(iLastRow + 1).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    ' Na nova última linha, formata as bordas
    iLastRow = iLastRow + 1
    Range(Cells(iLastRow, 1), Cells(iLastRow, 6)).Select

    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With

    ' Força o reposicionamento dos botões na célula abaixo da última linha, coluna 6
    ' Não era absolutamente necessário pois a inserção da linha "empurra" os botões
    ' pra baixo, mas serve pra ilustrar como fazer.
    PositionButtons iLastRow + 1, 6
    Cells(iLastRow, 1).Select

    ' Protege a folha atual
    ProtectSheet

    ' Tenta restaurar a seleção atual
    oSave.Select

    ' Religa a atualização da tela
    Application.ScreenUpdating = True

End Sub

' Sub do botão "-" para remover a última linha
Public Sub RemoveRow()

    On Error Resume Next

    Dim iLastRow As Integer
    Dim oSave As Range

    ' Pega o número da última linha
    iLastRow = getRowCount() + 1 ' Soma 1 porque a contagem começa na linha 2

    ' Se a última linha for a única, não faz nada
    If iLastRow <= 2 Then
        Exit Sub
    End If

    ' Salva a seleção atual
    Set oSave = Selection

    ' Desliga a atualização da tela temporariamente
    Application.ScreenUpdating = False

    ' Desprotege a folha atual
    UnprotectSheet

    ' Remove a última linha
    Range(Cells(iLastRow, 1), Cells(iLastRow, 6)).Select
    Selection.Delete Shift:=xlUp

    ' Reformata as bordas da nova última linha
    iLastRow = iLastRow - 1
    Range(Cells(iLastRow, 1), Cells(iLastRow, 6)).Select

    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With

    ' Força o reposicionamento dos botões na célula abaixo da última linha, coluna 6
    ' Não era absolutamente necessário pois a inserção da linha "empurra" os botões
    ' pra baixo, mas serve pra ilustrar como fazer.
    PositionButtons iLastRow + 1, 6
    Cells(iLastRow, 1).Select

    ' Protege a folha atual
    ProtectSheet

    ' Tenta restaurar a seleção atual
    oSave.Select

    ' Religa a atualização da tela
    Application.ScreenUpdating = True

End Sub

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .