VBA遍历控件，并在指定的位置赋值-526互联

Sub 遍历控件并赋值()
    Dim ws As Worksheet
    Dim shp As Shape
    Dim ctrlName As String
    Dim ctrlValue As Integer
    
    Set ws = ThisWorkbook.Worksheets(1) ' 表示第一个工作表
    
    ' 设置控件名和对应位置的数组
    Dim controlArray() As Variant
    controlArray = Array(Array(1029, "E19"), _
                        Array(1295, "M19"))
    
    For Each shp In ws.Shapes
        ctrlValue = shp.OLEFormat.Object.Value
        ctrlName = shp.Name
        Debug.Print CStr(shp.ID) + " " + shp.Name
        ' 对比控件名与数组中的控件名
        For i = LBound(controlArray) To UBound(controlArray)
            If shp.ID = controlArray(i)(0) Then
                ' 根据控件值写入相应位置的值
                If ctrlValue > 0 Then
                    ws.Range(controlArray(i)(1)).Value = 1
                Else
                    ws.Range(controlArray(i)(1)).Value = 0
                End If
                Exit For
            End If
        Next i
    Next shp
End Sub