Можно ли вернуть имена флажков в Excel VBA?

Question

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

Кто-нибудь знает, возможно ли это?

Заранее большое спасибо!

Answer 1

Рассмотрите возможность использования свойства TopLeftCell

Sub ListCheckBoxes()

    Dim ole As OLEObject

    'Loop through all the active x controls
    For Each ole In Sheet1.OLEObjects
        'Only care about checkboxes
        If TypeName(ole.Object) = "CheckBox" Then
            'Check topleftcell property
            If ole.TopLeftCell.Column = Sheet1.Range("G1").Column Then
                'print out list
                Debug.Print ole.TopLeftCell.Address, ole.Name
            End If
        End If
    Next ole

End Sub

Answer 2

Код ниже будет работать, если вы укажете столбец, который хотите проверить.

Например, если вы хотите найти все флажки в столбце E, укажите 5, а код проверяет любой флажок, который находится в пределах самой левой части столбца E и столбца F.

Sub ListCheckBoxNames()
    Dim col As Long, cb As OLEObject

    col = 5 //e.g. A=1, B=2, C=3 etc...you need to change this as appropriate

    For Each cb In Worksheets(1).OLEObjects
        If cb.Left >= Columns(col).Left And cb.Left < Columns(col + 1).Left Then
            Debug.Print cb.Name
        End If
    Next cb
End Sub

Answer 3

Если вы выровняете элемент управления по столбцу G (удерживая нажатой клавишу ALT во время перемещения для выравнивания), выберите свойства и найдите левую позицию элемента управления

Затем вы можете использовать этот код, чтобы определить, какие элементы управления из Sheet1 имеют выравнивание по левому краю так, как вам нужно.

Sub test()
lngcolumnGLeft = 288 'pseudo position of object aligned to column G

'cycle through all objects
With Sheet1

    For Each obj In .OLEObjects
        If obj.Left = lngcolumnGLeft Then

            .Range("G" & .Rows.Count).End(xlUp).Offset(1, 0).Value = obj.Name

        End If
    Next obj

End With

End Sub