按其驻留单元格位置启用/禁用复选框

Question

我想根据另一个复选框的值/条件使用 vba 禁用/启用 excel 工作表中的复选框。我不能使用复选框名称，我想使用它的单元格位置来参考启用/禁用它的复选框的单元格位置。像这样：

Sub Software2()
    Dim myRange As Range
    Set myRange = Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address)
    If ActiveSheet.Shapes(Application.Caller).ControlFormat.Value = 1 Then
        myRange.Interior.ColorIndex = 35
        myRange.Offset(0, 1).Interior.ColorIndex = 35
        myRange.Offset(0, 2).Interior.ColorIndex = 35
        myRange.Offset(1, 1).Interior.ColorIndex = 44
        myRange.Offset(1, 2).Interior.ColorIndex = 44
        myRange.Offset(2, 1).Interior.ColorIndex = 44
        myRange.Offset(2, 2).Interior.ColorIndex = 44
    Else
        myRange.Interior.ColorIndex = 44
        myRange.Offset(0, 1).Interior.ColorIndex = 44
        myRange.Offset(0, 2).Interior.ColorIndex = 44
        myRange.Offset(1, 1).Interior.ColorIndex = 0
        myRange.Offset(1, 2).Interior.ColorIndex = 0
        myRange.Offset(2, 1).Interior.ColorIndex = 0
        myRange.Offset(2, 2).Interior.ColorIndex = 0
        'ActiveSheet.Shapes(location of other checkbox).ControlFormat.Enabled = 0
        'ActiveSheet.Shapes(location of other checkbox).ControlFormat.Enabled = 0
    End If
End Sub

Answer 1

下面是如何按控件相对于区域的位置查找控件的演示。

TopLeftCell有点挑剔，因为控件可能会向顶部和/或左侧漂移，因此找不到。 使用相对上/左位置更可靠一些。

您甚至可以将两者结合起来 - 取决于单元格和控件的相对大小。

Option Explicit
Sub Tester()
    Dim cb
    Set cb = GetControlFromRange(Range("B6"))
    If Not cb Is Nothing Then
        Debug.Print cb.Name
        'toggle enabled
        With cb.ControlFormat
            .Enabled = Not .Enabled
        End With
    End If

End Sub

Function GetControlFromRange(rng As Range) As Object
    Const POS_DELTA_MAX As Long = 10
    Dim c As Object, s As Shape
    For Each s In rng.Parent.Shapes
        If s.Type = msoFormControl Then
            'using TopLeftCell
'            If Not Application.Intersect(s.TopLeftCell, rng) Is Nothing Then
'                Set c = s
'                Exit For
'            End If
            'using position
            If Abs(s.Top - rng.Top) < POS_DELTA_MAX And _
               Abs(s.Left - rng.Left) < POS_DELTA_MAX Then
                Set c = s
                Exit For
            End If
        End If
    Next s
    Set GetControlFromRange = c
End Function