如何根据VBA中另一个范围内的值将自动生成的选项按钮设置为"True"？

Question

我已经在另一个问题的答案的帮助下生成了单选按钮,如何在VBA中将自动生成的单选按钮设置为true？.

我的要求是将自动生成的选项按钮设置为"True"当另一个工作表中存在值"x"时.请参考图片.

图1:检查值的来源,

图2:Mark'x'应反映为True的工作表.

对于2行和2列中的选项按钮,生成的单选按钮的索引为OB2_2.

这是我一直在尝试的代码,

Private Sub AddOptionButtons(ByRef TargetRange As Range)

Dim m As Variant
m = Sheets("ALLO").Range("D23").Value + 1

Sheets("Final").Range("A2:A" & m).Copy Destination:=Sheets("Int_Result").Range("A2:A" & m)

Dim oCell As Range
For Each oCell In TargetRange
    oCell.RowHeight = 20
    oCell.ColumnWidth = 6
    Dim oOptionButton As OLEObject
    Set oOptionButton = TargetRange.Worksheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Left:=oCell.Left + 1, Top:=oCell.Top + 1, Width:=15, Height:=18)
    oOptionButton.Name = "OB" & oCell.row & "_" & oCell.Column
    oOptionButton.Object.GroupName = "grp" & oCell.Top

Next
Call OB2_Click(oCell)

End Sub

Sub OB2_Click(oCell)

Dim col, ro, m As Variant
Dim Shap As Shape
m = Sheets("ALLO").Range("D23").Value + 1

For Each Shap In Sheets("Int_Result").Shapes
    For ro = 2 To m Step 1
        For col = 1 To 13 Step 1
            If Sheets("Final").Cells(ro, col).Value = "" Then
               Sheets("Int_Result").Shapes(ro, col).ControlFormat.Value = False
            Else
               Sheets("Int_Result").Shapes(ro, col).ControlFormat.Value = True
            End If
        Next col
    Next ro
Next Shap

End Sub

当我尝试此代码时,我收到错误消息"对象变量或未设置块变量"或"参数数量错误或无效属性分配".引导我访问自动生成的单选按钮.

请帮帮我.先感谢您!

Answer 1

你需要使用

 Sheets("Int_Result").OLEObjects("OB2_2").Object.Value = True

设置循环不用于形状，而是正常到最后一行和最后一列。

例如：

Dim oCell As Range
Dim LastCell As Range
For Each oCell In TargetRange
    oCell.RowHeight = 20
    oCell.ColumnWidth = 6
    Dim oOptionButton As OLEObject
    Set oOptionButton = TargetRange.Worksheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Left:=oCell.Left + 1, Top:=oCell.Top + 1, Width:=15, Height:=18)
    oOptionButton.Name = "OB" & oCell.Row & "_" & oCell.Column
    oOptionButton.Object.GroupName = "grp" & oCell.Top
    Set LastCell = oCell

Next
Call OB2_Click(LastCell)

Sub OB2_Click(oCell as Range)

Dim col As Long, ro As Long
dim m as long, k as long

col = oCell.Column
ro = oCell.Row

For m = 2 to ro
    For k = 2 to col
         If Sheets("Final").Cells(m, k).Value = "" Then
             Sheets("Int_Result").OLEObjects("OB" & m & "_" & k).Object.Value = False
         Else
             Sheets("Int_Result").OLEObjects("OB" & m & "_" & k).Object.Value = True
         End If
    Next k
Next m
End sub