3
I have an excel table with only one row (plus the header) and six columns. The entire sheet is protected except this line.
At the end of the table I wanted to have a button (+) that adds a new row, and a button (-) that removes the last row from the table, except if it is the original row (this can never be removed).
How can I do this?
3
Credit the original idea of unlocking, altering and blocking the user @Strokes.
What you can do is keep the sheet protected and in the button code use the following order:
The only "problem" of this approach is that you need to set the password for protection directly in the code, so anyone with any knowledge (enough to use the ALT+F11 shortcut) will easily find it. But this will probably be enough for your need.
*In the example below I made a sub to reposition the buttons, but it is unnecessary because the insertion and removal of lines code uses Excel’s own line shift feature, which already correctly positions the content below the table. Thus, it serves only as a reference of how to do (and also because when I inserted the buttons I did not manually position them to be the way they are).
Below I share the sample code that manages the table as illustrated below:
This code uses the color white to differentiate the lines that are part of the table, considers as fixed the columns 1 to 6, as fixed the initial line in 2 and as fixed the names of the buttons in AddBtn and RemoveBtn (which respectively call the subs AddRow and RemoveRow). The code also seeks to maintain the formatting, current selection and user content around the table as lines are inserted and/or removed.
The sample sheet can be downloaded from 4shared. Here’s the code:
' 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
Browser other questions tagged excel vba table
You are not signed in. Login or sign up in order to post.
Insert is possible, but remove in the tests I did not possible due the spreadsheet is protected.
– rubStackOverflow
What if we check if she’s the "main" line first? Then after each line addition and subtraction it will protect before, and again when the action ends.
– Matt S
The path is what @Strokes suggested: unprotect the spreadsheet, make the change, and protect it again. I made a reply with a solution suggestion with this idea.
– Luiz Vieira