添加没有标题单元格的复选框

Question

我试图找到与同一问题相关的旧帖子，但找不到适合我的代码的解决方案。

每次向 sheet 添加新行时，我都尝试向 Excel sheet 添加复选框。将日期添加到范围 A11:A80 时，应添加复选框。但是，使用我当前的代码添加了复选框，但总是添加了我不想要的标题。

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A11:A80")) Is Nothing Then
Call checkbox
End If
End Sub


Sub checkbox()

    Dim wsTarget As Worksheet
    Dim oCheckBox As checkbox
    Dim r As Range
    Dim cell As Range
    
    Set wsTarget = ActiveSheet
    Set r = wsTarget.Range("A11:A80")
    
    With wsTarget
    For Each cell In r
        If Weekday(cell, vbMonday) > 5 Then

        Else
        If Not IsEmpty(cell.Value) Then
            .CheckBoxes.Add Left:=cell.Offset(0, 9).Left, Top:=cell.Offset(0, 9).Top, Width:=60, Height:=15
            
        End If
        End If
        Next cell
    End With

End Sub

另一个问题是，当我修改 A11:A80 范围内的单元格时，不会添加复选框，它仅在我手动运行宏

时有效

非常感谢所有帮助！提前谢谢你

Answer 1

使用选择复选框修改属性。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A11:A80")) Is Nothing Then
        Call checkbox
    End If
End Sub


Sub checkbox()
    Dim wsTarget As Worksheet
    Dim oCheckBox As checkbox
    Dim r As Range
    Dim cell As Range
    
    Set wsTarget = ActiveSheet
    Set r = wsTarget.Range("A11:A80")
    
    With wsTarget
    For Each cell In r
        If Weekday(cell, vbMonday) > 5 Then

        Else
        If Not IsEmpty(cell.Value) Then
            ActiveSheet.CheckBoxes.Add(cell.Offset(0, 9).Left, cell.Offset(0, 9).Top, 60, 15).Select
            With Selection
                .Caption = "Test caption name"
                .Value = xlOn 'xlOff to default
            End With
            
        End If
        End If
        Next cell
    End With

End Sub

Answer 2

(1) 设置标签很简单。您所要做的就是将创建的复选框分配给一个变量并使用它：

cb As CheckBox
Set cb = .CheckBoxes.Add(Left:=cell.Offset(0, 9).Left, Top:=cell.Offset(0, 9).Top, Width:=60, Height:=15)
cb.Caption = ""

(2) 我假设您的 Worksheet_Change-事件在错误的地方，它需要在 Worksheet-Module。我看不出它没有被触发的其他原因

(3) 如果您多次调用 checkbox-routine，它会为每一行创建多个复选框。我建议您为包含行号的每个复选框设置一个名称，并在添加新复选框之前进行测试（如果它已经存在）。

Dim cbName As String, cb As CheckBox
cbName = "checkBox_" & cell.Address
                                
On Error Resume Next
Set cb = Nothing
Set cb = .CheckBoxes(cbName)
On Error GoTo 0

If cb Is Nothing Then
    Set cb = .CheckBoxes.Add(Left:=cell.Offset(0, 9).Left, Top:=cell.Offset(0, 9).Top, Width:=60, Height:=15)
    cb.Caption = ""
    cb.Name = cbName
End If

添加没有标题单元格的复选框

Add checkbox without caption cell

excel

vba