使用 VBA 检索形状值时出现活动错误 438

Question

这个问题是我之前 2 个问题（Retrieving name and location of specific Shapes from worksheet with VBA 和 Retrieving information of OLEObjects from Workbook with 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

运行时，代码在行中产生 Active 错误 438：

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

我想从复选框中获取任何类型的值表示（真/假、是/否、1/0...）

问题：为什么会出现这个错误？如何解决这个问题？

Answer 1

试试

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 2

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 3

我认为您正在寻找的是 FormControlType 属性。我玩了你的例子，并使用智能感知找到了这个属性。查看 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

正如其他评论者所指出的，弹出的错误是由于代码遇到不具有您要求的属性的形状对象。然后产生错误。