选中任何复选框时触发事件
Event trigger when any checkbox is checked
我有一份工作sheet,其中有一份等待从工厂发货的汽车零件清单。我需要在每个单元格中用复选框填充第 I 列。
我创建了一个名为“CREATE CHECKBOXES”的按钮,它查看存在多少行数据,然后使用从 CheckBox1 到 CheckboxN 的 ActiveX 复选框填充列 I 的每个单元格(n = 包含数据的行数)。那部分已经想通了。
接下来,当用户选中任何复选框时,它必须弹出一个带有 2 个数据字段输入的用户表单,这些输入将插入到已选中复选框同一行的 J 和 K 列中。我卡在代码中的地方是在选中任何复选框时触发用户窗体弹出的事件。
我看到了 ),但现在由于代码将复选框计为形状,我无法添加任何类型的按钮来向其添加宏。
我必须删除“CREATE CHECKBOXES”按钮,否则来自链接 post 的代码将无法工作。
如何在选中任何复选框并保持形状按钮时触发此用户窗体事件?
之后肯定会发生一些事情,但我想我可以处理。
我创建了一个名为 ChkClass 的 class 模块,代码如下:
' put all this code in class a module and name the class module "ChkClass"
Option Explicit
Public WithEvents ChkBoxGroup As MSForms.CheckBox
Private Sub ChkBoxGroup_Change()
Debug.Print "ChkBoxGroup_Change"
End Sub
然后将其粘贴到 sheet 代码中:
' this goes into sheet code
Private Sub Worksheet_Activate()
activateCheckBoxes
End Sub
在那之后,我创建了一个模块,它是从链接 post:
稍微改编而来的
' this code goes into a module
Option Explicit
Dim CheckBoxes() As New ChkClass
Sub doCheckBoxes()
makeCheckBoxes
activateCheckBoxes
End Sub
Sub makeCheckBoxes()
Sheets(2).Select
Dim c As Range
Dim ultlinha As Integer
ultlinha = Range("A2").End(xlDown).Row
Range(Cells(2, 9), Cells(ultlinha, 9)).Select
For Each c In Selection
With ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Left:=c.Left, Top:=c.Top, Width:=c.Width, Height:=c.Height)
DoEvents
.Object.Caption = "FATURADO"
.LinkedCell = c.Offset(0, 3).Address
.Object.Value = 0 'sets checkbox to false
.Object.Font.Name = "Calibri"
.Object.Font.Size = 9
.Object.Font.Italic = True
.Object.BackStyle = fmBackStyleTransparent
End With
Next
Range("a1").Select
End Sub
Sub activateCheckBoxes() ' assigns all checkBoxes on worksheet to ChkClass.ChkBoxGroup
Dim sht As Worksheet
Set sht = ActiveSheet
ReDim CheckBoxes(1 To 1)
Dim i As Integer
For i = 1 To sht.Shapes.Count
ReDim Preserve CheckBoxes(1 To i)
Set CheckBoxes(i).ChkBoxGroup = sht.Shapes(i).OLEFormat.Object.Object
Next i
End Sub
问题出在这一行:
Set CheckBoxes(i).ChkBoxGroup = sht.Shapes(i).OLEFormat.Object.Object
如果 sheet 中没有其他按钮或形状,它会正确运行。如果我添加单个按钮或表单以向其添加宏,它不起作用。
如果您只想“激活”复选框,那么您可以遍历 sheet 的 OLEObjects
集合,只捕获复选框。
Sub activateCheckBoxes()
Dim sht As Worksheet, obj As OLEObject, n As Long
Set sht = ActiveSheet
ReDim CheckBoxes(1 To 1)
Dim i As Integer
For Each obj In sht.OLEObjects
If TypeName(obj.Object) = "CheckBox" Then 'is a checkbox?
n = n + 1
If n > 1 Then ReDim Preserve CheckBoxes(1 To n)
Set CheckBoxes(n).ChkBoxGroup = obj.Object
End If
Next obj
End Sub
我有一份工作sheet,其中有一份等待从工厂发货的汽车零件清单。我需要在每个单元格中用复选框填充第 I 列。
我创建了一个名为“CREATE CHECKBOXES”的按钮,它查看存在多少行数据,然后使用从 CheckBox1 到 CheckboxN 的 ActiveX 复选框填充列 I 的每个单元格(n = 包含数据的行数)。那部分已经想通了。
接下来,当用户选中任何复选框时,它必须弹出一个带有 2 个数据字段输入的用户表单,这些输入将插入到已选中复选框同一行的 J 和 K 列中。我卡在代码中的地方是在选中任何复选框时触发用户窗体弹出的事件。
我看到了
我必须删除“CREATE CHECKBOXES”按钮,否则来自链接 post 的代码将无法工作。
如何在选中任何复选框并保持形状按钮时触发此用户窗体事件?
之后肯定会发生一些事情,但我想我可以处理。
我创建了一个名为 ChkClass 的 class 模块,代码如下:
' put all this code in class a module and name the class module "ChkClass"
Option Explicit
Public WithEvents ChkBoxGroup As MSForms.CheckBox
Private Sub ChkBoxGroup_Change()
Debug.Print "ChkBoxGroup_Change"
End Sub
然后将其粘贴到 sheet 代码中:
' this goes into sheet code
Private Sub Worksheet_Activate()
activateCheckBoxes
End Sub
在那之后,我创建了一个模块,它是从链接 post:
稍微改编而来的' this code goes into a module
Option Explicit
Dim CheckBoxes() As New ChkClass
Sub doCheckBoxes()
makeCheckBoxes
activateCheckBoxes
End Sub
Sub makeCheckBoxes()
Sheets(2).Select
Dim c As Range
Dim ultlinha As Integer
ultlinha = Range("A2").End(xlDown).Row
Range(Cells(2, 9), Cells(ultlinha, 9)).Select
For Each c In Selection
With ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Left:=c.Left, Top:=c.Top, Width:=c.Width, Height:=c.Height)
DoEvents
.Object.Caption = "FATURADO"
.LinkedCell = c.Offset(0, 3).Address
.Object.Value = 0 'sets checkbox to false
.Object.Font.Name = "Calibri"
.Object.Font.Size = 9
.Object.Font.Italic = True
.Object.BackStyle = fmBackStyleTransparent
End With
Next
Range("a1").Select
End Sub
Sub activateCheckBoxes() ' assigns all checkBoxes on worksheet to ChkClass.ChkBoxGroup
Dim sht As Worksheet
Set sht = ActiveSheet
ReDim CheckBoxes(1 To 1)
Dim i As Integer
For i = 1 To sht.Shapes.Count
ReDim Preserve CheckBoxes(1 To i)
Set CheckBoxes(i).ChkBoxGroup = sht.Shapes(i).OLEFormat.Object.Object
Next i
End Sub
问题出在这一行:
Set CheckBoxes(i).ChkBoxGroup = sht.Shapes(i).OLEFormat.Object.Object
如果 sheet 中没有其他按钮或形状,它会正确运行。如果我添加单个按钮或表单以向其添加宏,它不起作用。
如果您只想“激活”复选框,那么您可以遍历 sheet 的 OLEObjects
集合,只捕获复选框。
Sub activateCheckBoxes()
Dim sht As Worksheet, obj As OLEObject, n As Long
Set sht = ActiveSheet
ReDim CheckBoxes(1 To 1)
Dim i As Integer
For Each obj In sht.OLEObjects
If TypeName(obj.Object) = "CheckBox" Then 'is a checkbox?
n = n + 1
If n > 1 Then ReDim Preserve CheckBoxes(1 To n)
Set CheckBoxes(n).ChkBoxGroup = obj.Object
End If
Next obj
End Sub