VBA: флажки в массиве групповых флажков

Question

Я использую подпрограмму, в которой мне нужно подсчитать количество отмеченных флажков в групповом поле и сделать это для нескольких групповых блоков. Изменить: я забыл упомянуть, что я использую элементы управления формы, а не элементы управления ActiveX.

Моя первая проблема - создание массива групповых блоков. Я пытался использовать

GB_Array = Activesheet.Shapes.Range(Array(Cells(x, y), Cells(z, y))) ' x,y,z defined elsewhere

Я могу сделать это, добавив вручную, но это не идеально. Моя вторая проблема с этой частью:

Option Base 1
Dim cbox as Checkbox
Dim C_cbox as Integer

GB_Array = Array("Name1", "Name2") ' Manually adding groupboxes to the array

For i = 1 to Ubound(GB_Array, 1)
  For Each cBox In Activesheet.Shapes.Range(GB_Array(1))
    If cBox.Checked = True Then
         C_cbox = C_cbox + 1
    End If
  Next cBox
Next i

Возвращает ошибку несоответствия типов 13. РЕДАКТИРОВАТЬ: Похоже, что я сделал ошибку, сгруппировав групповой блок с флажками, ответ работает для «разгруппированных» групповых блоков (поэтому я могу перемещать групповые блоки без флажков).

Answer 1

Это то, что вы пытаетесь?

Мои предположения: Все элементы управления являются элементами управления формой.

Я прокомментировал код, поэтому у вас не должно возникнуть проблем с его пониманием. Тем не менее, если у вас есть какие-либо вопросы, просто спросите:)

Sub Sample()
    Dim ws As Worksheet
    Dim gbox As GroupBox
    Dim Shp As Shape
    Dim rngGBox As Range
    Dim C_cbox As Integer

    '~~> Change this to the relevant sheet
    Set ws = Sheet1

    With ws
        '~~> Loop through group boxes
        For Each gbox In .GroupBoxes
            '~~> Get the range of the groupbox
            Set rngGBox = .Range(gbox.TopLeftCell, gbox.BottomRightCell)

            '~~> Loop through all shapes
            For Each Shp In gbox.Parent.Shapes
                If Shp.Type = msoFormControl Then
                    '~~> Check if the shape is within the groupbox range
                    If Not Intersect(Shp.TopLeftCell, rngGBox) Is Nothing Then
                        If Not Shp Is gbox Then
                            '~~> Check if it is a checkbox
                            If Shp.FormControlType = xlCheckBox Then
                                '~~> Check if it is checked
                                If Shp.ControlFormat.Value = xlOn Then
                                    C_cbox = C_cbox + 1
                                End If
                            End If
                        End If
                    End If
                End If
            Next Shp
        Next gbox
    End With
End Sub

А если вы хотите работать с определенными групповыми блоками, вы можете использовать это

Sub Sample()
    Dim ws As Worksheet
    Dim grpBxNames As String
    Dim grpBxArray As Variant
    Dim gbox As GroupBox
    Dim Shp As Shape
    Dim rngGBox As Range
    Dim C_cbox As Integer

    '~~> Change this to the relevant sheet
    Set ws = Sheet1

    '~~> Put the names separated by comma
    '~~> we will create the array during runtime
    grpBxNames = "Group Box 1,Group Box 6"
    grpBxArray = Split(grpBxNames, ",")

    With ws
        '~~> Loop through array of group boxes
        For i = 1 To UBound(grpBxArray)
            '~~> Set you object
            Set gbox = .GroupBoxes(grpBxArray(i))

            '~~> Get the range of the groupbox
            Set rngGBox = .Range(gbox.TopLeftCell, gbox.BottomRightCell)

            '~~> Loop through all shapes
            For Each Shp In gbox.Parent.Shapes
                If Shp.Type = msoFormControl Then
                    '~~> Check if the shape is within the groupbox range
                    If Not Intersect(Shp.TopLeftCell, rngGBox) Is Nothing Then
                        If Not Shp Is gbox Then
                            '~~> Check if it is a checkbox
                            If Shp.FormControlType = xlCheckBox Then
                                '~~> Check if it is checked
                                If Shp.ControlFormat.Value = xlOn Then
                                    C_cbox = C_cbox + 1
                                End If
                            End If
                        End If
                    End If
                End If
            Next Shp
        Next
    End With
End Sub

Answer 2

Я не верю, что вам нужен массив флажков. Пожалуйста, посмотрите на код ниже.

Sub ResetCheckBoxes()
  Dim Ctrl As OLEObject
  Dim n As Integer

  For Each Ctrl In ActiveSheet.OLEObjects
      If TypeName(Ctrl.Object) = "CheckBox" Then
            Debug.Print Ctrl.Object.GroupName, Ctrl.Object.Value
            Ctrl.Object.Value = True
      End If
  Next Ctrl
End Sub

Код проходит по всем элементам управления ActiveX в ActiveSheet и выбирает флажки. Затем он печатает свойства GroupName и Value блока перед изменением значения. Запустите код еще раз, чтобы увидеть измененное значение.

GroupName - это имя вкладки по умолчанию. Вы можете присвоить ему другое значение либо вручную, при создании флажка, либо с помощью приведенного выше кода. Когда все флажки в определенной группе имеют одинаковое имя группы, вы можете добавить еще одно условие If в вышеуказанный цикл и выбрать только те, которые принадлежат этой конкретной группе - и это соответствует вашему назначению массива.