Активная ошибка 438 при получении значения фигуры с помощью VBA

Question

Этот вопрос является продолжением двух моих предыдущих вопросов ( Получение имени и местоположения определенных фигур из рабочего листа с помощью VBA и Получение информации об объектах OLEObject из Workbook с помощью VBA )

Сценарий: Я пытаюсь получить данные из рабочей таблицы, включая необработанные данные и фигуры (в основном флажки).Я использую следующий код для получения флажков:

Sub CheckboxLoop17()

Dim cb As Shape
Dim i As Long

i = 1

'Loop through Checkboxes
  For Each cb In ThisWorkbook.Sheets(1).Shapes
    ThisWorkbook.Sheets(4).Cells(i, 1).Value = cb.ControlFormat.Value
    ThisWorkbook.Sheets(4).Cells(i, 2).Value = cb.Name
    ThisWorkbook.Sheets(4).Cells(i, 3).Value = cb.BottomRightCell.Address
    ThisWorkbook.Sheets(4).Cells(i, 4).Value = cb.Type
    i = i + 1
  Next cb

End Sub

При запуске код выдает активную ошибку 438 в строке:

ThisWorkbook.Sheets(4).Cells(i, 1).Value = cb.ControlFormat.Value

Где я хочу получить любой типпредставления значения из флажка (true / false, yes / no, 1/0 ...)

Вопрос: Почему происходит эта ошибка?Как это исправить?

Answer 1

Excel упаковывает каждый объект ActiveX в элемент управления OLEObject, который затем переносится в объект Shape.

При итерации по Worksheets().Shapes вам нужно будет ссылаться на Shape..Object.Object.Value

ThisWorkbook.Sheets(4).Cells(i, 1).Value = cb.OLEFormat.Object.Object.Value

Было бы более простым циклически проходить по коллекции Worksheets().OLEObjects.

Sub CheckboxLoop17_OLEObjects()
    Dim ctrl As OLEObject
    Dim i As Long

    i = 1

    'Loop through Checkboxes
    For Each ctrl In ThisWorkbook.Sheets(1).OLEObjects
        ThisWorkbook.Sheets(4).Cells(i, 1).Value = ctrl.Object.Value
        ThisWorkbook.Sheets(4).Cells(i, 2).Value = ctrl.Name
        ThisWorkbook.Sheets(4).Cells(i, 3).Value = ctrl.BottomRightCell.Address
        ThisWorkbook.Sheets(4).Cells(i, 4).Value = ctrl.progID
        i = i + 1
    Next
End Sub

Если у вас есть элементы управления как Form, так и ActiveX, вам нужно будет проверить, какой вы типработа с.

Sub MixedFormsAndActiveX()
    Dim sh As Shape
    Dim i As Long
    For Each sh In ThisWorkbook.Sheets(1).Shapes
        i = i + 1
        With ThisWorkbook.Sheets(4)
            If sh.Type = msoOLEControlObject Then
                .Cells(i, 1).Value = sh.OLEFormat.Object.Object.Value
                .Cells(i, 4).Value = "ActiveX Control: " & TypeName(sh.OLEFormat.Object.Object)
            ElseIf sh.Type = msoFormControl Then
                .Cells(i, 1).Value = sh.ControlFormat.Value
                .Cells(i, 4).Value = "Forms Control: " & TypeName(sh.ControlFormat)
            End If
            .Cells(i, 2).Value = sh.Name
            .Cells(i, 3).Value = sh.BottomRightCell.Address
        End With
    Next
End Sub

Answer 2

Попробуйте

Sub CheckboxLoop17()

    Dim cb As Shape
    Dim i As Long
    Dim s As String
    Dim Ws As Worksheet, shpWs As Worksheet

    Set shpWs = ThisWorkbook.Sheets(1)
    Set Ws = ThisWorkbook.Sheets(4)
    i = 1

    'Loop through Checkboxes
    With Ws
      For Each cb In shpWs.Shapes

        If cb.Type = msoFormControl Then
            If cb.FormControlType = xlCheckBox Then
                .Cells(i, 1).Value = cb.ControlFormat.Value
                .Cells(i, 2).Value = cb.Name
                .Cells(i, 3).Value = cb.BottomRightCell.Address
                .Cells(i, 4).Value = cb.Type
            End If
        ElseIf cb.Type = 12 Then
            s = cb.OLEFormat.progID
            If s = "Forms.CheckBox.1" Then
                .Cells(i, 1).Value = cb.OLEFormat.Object.Object.Value
                .Cells(i, 2).Value = cb.Name
                .Cells(i, 3).Value = cb.BottomRightCell.Address
                .Cells(i, 4).Value = cb.Type
            End If
        End If
        i = i + 1
      Next cb
    End With

End Sub

Answer 3

Я думаю, что вы ищете, это свойство FormControlType.Я поиграл с твоим примером и с помощью intellisense нашел это свойство.Глядя на описание MS, у них был следующий пример:

For Each s In Worksheets(1).Shapes
    If s.Type = msoFormControl Then
        If s.FormControlType = xlCheckBox Then _
            s.ControlFormat.Value = False
    End If
Next

Как отмечают другие комментаторы, всплывающая ошибка возникает из-за кода, встречающего объекты формы, которые не имеют запрашиваемых вами свойств.Затем выдается ошибка.