Excel 2007 - Buttons to create / remove rows

3

I have a table in excel with one line only (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 the original row (this can never be removed) / p>

How can I do this?

    
asked by anonymous 05.06.2014 / 15:59

1 answer

3
  

Credit for the original idea of unlock, change, and lock   user @Strokes .

What you can do is keep the sheet protected and in the button code use the following order:

  • Unprotect the sheet using the desired password
  • Insert (or remove) a line
  • Reposition the *
  • Re-protect the sheet using the same password
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, probably this will be enough for your need.

* In the example below I made a sub to reposition the buttons, but it is unnecessary because the line insertion and removal code uses the Excel line shift feature itself, which already correctly positions the content below of the table. So, it only serves as a reference for how to do (and also because when I inserted the buttons I did not manually position them to stay the way they are).

Below I share the sample code that manages the table as shown below:

Thiscodeuseswhitecolortodifferentiatetherowsthatarepartofthetable,considerasfixedthecolumnsfrom1to6,setthestartinglineto2andsetthenamesofthebuttonsinAddBtnandRemoveBtn(whichrespectivelycallthesubsAddRowandRemoveRow).Thecodealsoseekstokeeptheformatting,currentselection,andusercontentaroundthetableasrowsareinsertedand/orremoved.

The sample worksheet can be downloaded from 4Shared . Here is 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
    
03.07.2014 / 20:48