CheckBox incorporado no Excel

Question

Eu gostaria de inserir Check Boxes em cada célula E2: E30 e F2: F30, onde uma caixa deve ser marcada na coluna E ou na coluna F em cada linha.

    

Answer 1

No seu caso, usar os botões de opção é certamente a solução melhor / mais pragmática. Se você precisar emular um grupo de opções com caixas de seleção, veja mais abaixo

Grupo de opções

Maneira manual:

1. Insira uma Caixa de grupo (guia Desenvolvedor- > Inserir- > Controles de formulário > Caixa de grupo) - este é um retângulo no qual você colocará os diferentes botões de opção
2. Coloque os botões de opção que você precisa no retângulo (guia Desenvolvedor- > Inserir- > Controles de formulário > Botão de opção)
3. Selecione um dos botões de opção no seu grupo e vincule-o à célula que você quer - na caixa de diálogo Controle de formato (depois do clique direito) ou simplesmente digitando =$E$1 na barra de fórmulas.

Esta célula vinculada agora manterá o número do botão de opção pressionado; no seu caso, isso pode ser 1, 2 ou 3. Agora você pode combinar isso com qualquer outra função, por exemplo, INDEX/OFFSET/CHOOSE .

Modo VBA

A rotina a seguir colocará um grupo de opções ao lado de cada célula:

Private Const cStrPrefix As String = "o_"
Private Const cDblHorizontalSpacing As Double = 2
Private Const cDblLabelWidth As Double = 40

Private mWS As Worksheet
Private mStrAddr As String
Private mRngLink As Range
Private mVarLabels() As Variant
Private mIntCount As Integer

Public Sub subPlaceOptionGroupsInRange(rngLinks As Range, _
                         intNumberOfButtons As Integer, _
                         ParamArray varLabels() As Variant)

    Dim intOldCalcMode As Integer

    Application.ScreenUpdating = False
    intOldCalcMode = Application.Calculation
    Application.Calculation = xlCalculationManual

    'Init variables
    Set mWS = rngLinks.Worksheet
    mIntCount = intNumberOfButtons
    mVarLabels = varLabels

    For Each mRngLink In rngLinks.Cells
        mStrAddr = mRngLink.Address

        subDeleteOptionGroup
        subPlaceOptionGroup
        subPlaceOptionButtons

    Next

    Application.Calculation = intOldCalcMode
    Application.ScreenUpdating = True
End Sub

Private Sub subDeleteOptionGroup()
    Dim i As Integer

    On Error Resume Next
    For i = 1 To mIntCount
        mWS.OptionButtons(cStrPrefix & mStrAddr & "_" & i).Delete
    Next
    mWS.GroupBoxes(cStrPrefix & mStrAddr).Delete

End Sub

Private Sub subPlaceOptionGroup()
    Dim objGroupBox As GroupBox

    Set objGroupBox = mWS.GroupBoxes.Add( _
        mRngLink.Offset(, 1).Left, mRngLink.Top, _
        (mIntCount + 2) * cDblHorizontalSpacing + _
         mIntCount * cDblLabelWidth, _
        mRngLink.Height)
    With objGroupBox
        .Characters.Text = ""
        .Name = cStrPrefix & mStrAddr
        .Display3DShading = True
    End With

End Sub

Private Sub subPlaceOptionButtons()
    Dim i As Integer
    Dim objOptionButton As OptionButton
    For i = 1 To mIntCount
        Set objOptionButton = mWS.OptionButtons.Add( _
            mRngLink.Offset(, 1).Left _
            + i * cDblHorizontalSpacing + (i - 1) * cDblLabelWidth, _
            mRngLink.Top, cDblLabelWidth, mRngLink.Height)
        With objOptionButton
            .Characters.Text = mVarLabels(i - 1)
            .Display3DShading = True
            .Name = cStrPrefix & mStrAddr & "_" & i
            .LinkedCell = mStrAddr
        End With
    Next
End Sub

Você pode colocar os botões de opção executando 'subPlaceOptionGroupsInRange Sheets ("yourSheet"). Range ("E2: E30"), 3, "Label1", "Label2", "Label3"

Caixas de seleção

Se você quiser 3 caixas de seleção vinculadas ao grupo de opções, você precisará de uma célula / coluna para cada um dos três botões / opções. Em um exemplo, as células A1, B1, C1 são vinculadas a três caixas de seleção, que pertencem a um grupo.

Para alcançar o estado exclusivo mútuo, você precisará atribuir a macro a seguir a todos os botões de opção:

Public Sub subChangeCheckbox()
    Dim cb As CheckBox
    Dim rngTarget As Range
    Dim intCol As Integer

    Set cb = ActiveSheet.CheckBoxes(Application.Caller)
    Set rngTarget = ActiveSheet.Range(cb.LinkedCell)

    'Prevent unchecking
    If rngTarget.Value = False Then
        rngTarget.Value = True
        Exit Sub
    End If

    'Unselect previously selected checkbox
    For intCol = 1 To 3
        If rngTarget.Column  intCol Then
            ActiveSheet.Cells(rngTarget.Row, intCol).Value = False
        End If
    Next intCol

End Sub