Встроенный CheckBox в Excel

Question

Я хотел бы установить флажки в каждой ячейке E2:E30 и F2:F30, где один флажок должен быть отмечен либо в столбце E, либо в столбце F в каждой строке.

Answer 1

В вашем случае использование Option Buttons, безусловно, является лучшим / более прагматичным решением. Если вам нужно эмулировать группу опций с помощью флажков, см. Ниже

Вариант группы

Ручной способ:

1. Вставьте групповое поле (вкладка «Разработчик» -> «Вставка» -> «Элементы управления формой» -> «Групповое поле») - это прямоугольник, в который вы поместите различные кнопки выбора.
2. Поместите нужные опции в прямоугольник (вкладка «Разработчик» -> «Вставка» -> «Элементы управления формой» -> «Кнопка выбора»)
3. Выберите любую кнопку опции в своей группе и свяжите ее с нужной ячейкой - либо в диалоговом окне «Управление форматом» (после щелчка правой кнопкой мыши), либо просто набрав =$E$1 на панели формул.

Эта связанная ячейка теперь будет содержать номер нажатой кнопки выбора, в вашем случае это может быть 1, 2 или 3. Теперь вы можете комбинировать это с любой другой функцией, например, INDEX/OFFSET/CHOOSE .

Путь VBA

Следующая процедура помещает группу параметров рядом с каждой ячейкой:

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

Вы можете разместить свои кнопки выбора, запустив `subPlaceOptionGroupsInRange Sheets(" yourSheet ").Диапазон («E2:E30»), 3, "Label1", "Label2", "Label3"

Флажки

Если вы хотите, чтобы 3 флажка были связаны аналогично группе параметров, вам потребуется ячейка / столбец для каждой из трех кнопок / параметров. В примере ячейки A1, B1, C1 связаны с 3 флажками, которые принадлежат одной группе.

Чтобы достичь взаимоисключающего состояния, вам нужно назначить следующий макрос каждой кнопке выбора:

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