1

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

我的复选框来自表单工具栏。我可以取消选中这些框，但是一旦我插入代码以删除我得到的日期

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

这是我正在尝试使用的代码：

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
4

2 回答 2

1

根据您的描述，这应该可以完成工作。
几点：

  • 尽可能避免使用 ActiveSheet。Me.如果代码在工作表上，请直接参考相关工作表或使用。例如For Each cBox In Me.CheckBoxes。
  • 您没有将 LRow 添加到 ClearAllCheckBoxes 函数中，这是它缺少的地方。cBox.TopLeftCell.Row如果您直接引用and.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
于 2013-11-07T13:12:47.010 回答
0

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

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

我不清楚您在这里做什么或如何调用此程序。当您逐步完成它时，它的价值是LName什么，您期望它是什么？

请注意，此行需要CheckBoxes集合中的字符串（名称）或整数/索引值：

Set cBox = ActiveSheet.CheckBoxes(LName)

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

于 2013-11-05T14:57:07.887 回答