取消选中VBA中的复选框和相应数据

时间:2013-11-05 13:43:55

标签: excel vba checkbox clear uncheck

我正在尝试编写一个VBA代码,该代码将取消选中Excel中工作表上的所有复选框,并从复选框左侧的单元格中删除数据(这是复选框时从另一个宏填充的日期)检查)。

我的复选框来自表单工具栏。我可以取消选中复选框,但只要我插入代码删除我得到的日期

  

运行时错误'1004'“无法获取工作表类的checkboxes属性”。

以下是我正在尝试使用的代码:

Sub ClearAllCheckboxes()
Dim Answer As String
Dim MyNote As String
Dim CB As Object
Dim LRange As String
Dim cBox As CheckBox

LName = Application.Caller
Set cBox = ActiveSheet.CheckBoxes(LName)
MyNote = "This will Clear all CheckBoxes Proceed? "
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "???")
LRange = "F" & CStr(LRow)

If Answer = vbNo Then
    Exit Sub
Else
    For Each CB In ActiveSheet.CheckBoxes
        CB.Value = xlOff
        If cBox.Value = 0 Then
            ActiveSheet.Range(LRange).Value = Null
        End If
    Next CB
End If

End Sub

以下是复选框中使用的代码,用于添加日期并将信息记录在另一个工作表中:

Sub Process_CheckBox()

Dim cBox As CheckBox
Dim LRow As Integer
Dim LColumn As Integer
Dim RRow As Integer
Dim LRange As String
Dim RRange As String
Dim ERange As String
Dim FRange As String



LName = Application.Caller
Set cBox = ActiveSheet.CheckBoxes(LName)

'Find row that checkbox resides in
LRow = cBox.TopLeftCell.Row
LRange = "F" & CStr(LRow)
RRow = cBox.TopLeftCell.Row
RRange = "B" & CStr(RRow)
ERange = "E" & CStr(RRow)
FRange = "F" & CStr(RRow)


'Change date in column B, if checkbox is checked
If cBox.Value > 0 Then
ActiveSheet.Range(LRange).Value = Date
ActiveSheet.Range(RRange).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Log").Select
Range("A" & ActiveSheet.Rows.Count). _
End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False
Columns("A:A").EntireColumn.AutoFit

Sheets("Daily").Select
ActiveSheet.Range(ERange).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Log").Select
Range("D" & ActiveSheet.Rows.Count). _
End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False

Sheets("Daily").Select
ActiveSheet.Range(FRange).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Log").Select
Range("C" & ActiveSheet.Rows.Count). _
End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False

'Clear date in column B, if checkbox is unchecked
Else
  ActiveSheet.Range(LRange).Value = Null
End If

End Sub

2 个答案:

答案 0 :(得分:1)

根据您的描述,这应该做的工作 几点:

  • 尽可能避免使用ActiveSheet。如果代码在工作表上,请直接参考相关表格或使用Me.。例如For Each cBox In Me.CheckBoxes
  • 您没有将LRow添加到ClearAllCheckBoxes函数,这是它缺少的地方。如果您直接引用cBox.TopLeftCell.Row.Column值,则不需要它。
  • 您不需要将每个函数调用都保存到变量中。
    • 而不是:LName = Application.Caller, Set cBox = ActiveSheet.CheckBoxes(LName)
    • 执行:Set cBox = ActiveSheet.CheckBoxes(Application.Caller)
  • 同样,如果您以后不再使用该答案,则可以直接在Msgbox语句中使用If
  • 在尝试设置并获取其值时,通常不需要引用对象的Value属性,只需引用该对象。
  • 您可以在一行上标注多个变量。只需确保在每个变量名称旁边放置一个as <type>,或者将没有变量名称的变量名称放在变量名称旁边。
  • 您不需要在Next语句之后放置您正在循环的变量(除非您连续排列并且看起来很混乱)。
  • 下面的colOffset变量可以用整数代替。我不知道你的日期单元有多远,所以我把它放进去。在我的测试表中,它是盒子右边的一个单元格。


Sub ClearAllCheckboxes()
    Dim cBox As CheckBox, colOffset as Integer

    colOffset= 1 'You need to set this to however far away the date cell is from your checkbox
    If MsgBox("This will Clear all CheckBoxes Proceed? ", vbQuestion + vbYesNo, "???") = vbYes Then
        For Each cBox In ActiveSheet.CheckBoxes
           cBox = xlOff

           ActiveSheet.Cells(cBox.TopLeftCell.Row,cBox.TopLeftCell.Column + colOffset) = Null
        Next
    End If
End Sub

答案 1 :(得分:0)

如果您要对此进行调试,您可能会发现LName的值为Error 2023。当我在调试模式下使用F8单步执行此代码时,这就是我发生的情况,这会在下一行中引发错误Set cBox = ...

LName = Application.Caller   
Set cBox = ActiveSheet.CheckBoxes(LName)

我不清楚你在这里做什么或者如何调用这个程序。当您单步执行时,LName的价值是什么,以及期望它是什么?

请注意,此行需要CheckBoxes集合中的字符串(名称)或整数/索引值:

Set cBox = ActiveSheet.CheckBoxes(LName)

如果您确保传递给Lname的值不是错误值并确保它正确引用CheckBox上的ActiveSheet,那么您的代码应该按预期工作。