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

通过其驻留单元位置启用/禁用复选框

1 个答案: