Question

这个问题是我之前的两个问题（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

运行时，代码在行中产生活动错误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属性。我玩弄了您的示例，并使用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

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

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

3 个答案: