Question

我一直在为我们目前从遗留系统中提取的数据开发各种报告和表单。我已经创建了一个表单，可以根据创建的按钮数量动态创建按钮并对其进行空格。我的错误在于我尝试为每个按钮添加_Click（）功能，因为代码对于每个创建的按钮都是唯一的。我已经尝试了所有我能想到的东西以及我能在网上找到的所有东西都无济于事。通过各种不同的尝试，我已经得到了我在UserForm CodeModule中填充按钮和代码的点，但_Click（）事件不会从那里触发。任何帮助将不胜感激。

Private Sub CommandButton5_Click()

Dim lastrow As Long, i As Integer, numButtons As Integer, newButton As Control, lineNum As Long

numButtons = 1

With Sheets("Production Capacity")

    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

    .Range("A4:AD" & lastrow).Interior.Color = RGB(255, 255, 255)

    For i = 4 To lastrow
        If i Mod 4 = 0 Then
            If .Cells(i, "D").Value > .Cells(2, "G").Value Then
                .Cells(i, "G").Interior.Color = RGB(255, 0, 0)
                Set newButton = Me.Controls.Add("Forms.CommandButton.1", "button" & numButtons, False)
                With newButton
                    .Width = 200
                    Select Case (numButtons Mod 3)
                        Case 0
                            .Left = 475
                        Case 1
                            .Left = 25
                        Case 2
                            .Left = 250
                    End Select
                    .Visible = True
                    .Height = 20
                    .Top = 60 + (Int((numButtons - 1) / 3) * 40)
                    .Caption = Sheets("Production Capacity").Cells(i, "A").Value & " - " & Sheets("Production Capacity").Cells(i, "B").Value & " DeptName"
                    .Font.Size = 10
                    .Font.Bold = True
                End With

                With ActiveWorkbook.VBProject.VBComponents("Class1").CodeModule
                    lineNum = .CreateEventProc("Click", "button" & numButtons) + 1 'This line is where the error occurs.
                    .InsertLines lineNum, _
                        "Dim lastrow as Long" & Chr(13) & _
                        "with Sheets(Sheets(""Production Capacity"").cells(1, ""A"").value)" & Chr(13) & _
                        ".ShowAllData" & Chr(13) & _
                        "lastrow = .Cells(Rows.Count, ""B"").End(xlUp).Row" & Chr(13) & _
                        ".Range(""A$6:$BQ$"" & lastrow).AutoFilter field:=30, Criteria1:=" & Chr(34) & ">=" & Chr(34) & " & " & Chr(34) & DateValue(Sheets("Production Capacity").Cells(i, "A").Value) & Chr(34) & ", Operator:=xlAnd, Criteria2:=" & Chr(34) & "<=" & Chr(34) & " & " & Chr(34) & DateValue(Sheets("Production Capacity").Cells(i, "B").Value) & Chr(34) & ", Operator:=xlAnd" & Chr(13) & _
                        "End With"
                End With
                numButtons = numButtons + 1
            End If

错误是＆＃39;运行时错误＆＃39; 57017＆＃39;：事件处理程序无效

就在这一行：lineNum = .CreateEventProc("Click", "button" & numButtons) + 1

Answer 1

归功于@DisplayName！非常感谢您帮助我简化解决方案并停止过度设计。我的UserForm的新Sub如下：

Dim mColButtons As New Collection

Private Sub CommandButton5_Click()

Dim lastrow As Long, i As Integer, numButtons As Integer
Dim btnEvent As Class1
Dim ctl As MSForms.Control

numButtons = 1

With Sheets("Production Capacity")

    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

    .Range("A4:AD" & lastrow).Interior.Color = RGB(255, 255, 255)

    For i = 4 To lastrow
        If i Mod 4 = 0 Then
            If .Cells(i, "D").Value > .Cells(2, "G").Value Then
                .Cells(i, "G").Interior.Color = RGB(255, 0, 0)
                Set ctl = Me.Controls.Add("Forms.CommandButton.1")
                With ctl
                    .Width = 200
                    Select Case (numButtons Mod 3)
                        Case 0
                            .Left = 475
                        Case 1
                            .Left = 25
                        Case 2
                            .Left = 250
                    End Select
                    .Visible = True
                    .Height = 20
                    .Top = 60 + (Int((numButtons - 1) / 3) * 40)
                    .Caption = Sheets("Production Capacity").Cells(i, "A").Value & " - " & Sheets("Production Capacity").Cells(i, "B").Value & " DeptName"
                    .Font.Size = 10
                    .Font.Bold = True
                    .Name = "button" & numButtons
                End With

                Set btnEvent = New Class1
                Set btnEvent.btn = ctl
                Set btnEvent.frm = Me

                mColButtons.Add btnEvent

                numButtons = numButtons + 1
            End If

我的类模块现在看起来像这样，它将所有逻辑简化为简洁的Select语句。再次感谢你。

Public WithEvents btn As MSForms.CommandButton
Public frm As UserForm

Private Sub btn_click()

Dim startDate As String, endDate As String, department As String, lastrow As Long

startDate = Split(btn.Caption, " ")(0)
endDate = Split(btn.Caption, " ")(2)
department = Split(btn.Caption, " ")(3)

With Sheets(Sheets("Production Capacity").Cells(1, "A").Value)
    lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
    Select Case department
        Case "Veneering"
            .ShowAllData
            .Range("A$6:$BQ$" & lastrow).AutoFilter field:=21, Criteria1:=">=" & DateValue(startDate), Operator:=xlAnd, Criteria2:="<=" & DateValue(endDate), Operator:=xlAnd
        Case "MillMachining"
            .ShowAllData
            .Range("A$6:$BQ$" & lastrow).AutoFilter field:=30, Criteria1:=">=" & DateValue(startDate), Operator:=xlAnd, Criteria2:="<=" & DateValue(endDate), Operator:=xlAnd
        Case "BoxLine"
            .ShowAllData
            .Range("A$6:$BQ$" & lastrow).AutoFilter field:=39, Criteria1:=">=" & DateValue(startDate), Operator:=xlAnd, Criteria2:="<=" & DateValue(endDate), Operator:=xlAnd
        Case "Custom"
            .ShowAllData
            .Range("A$6:$BQ$" & lastrow).AutoFilter field:=48, Criteria1:=">=" & DateValue(startDate), Operator:=xlAnd, Criteria2:="<=" & DateValue(endDate), Operator:=xlAnd
        Case "Finishing"
            .ShowAllData
            .Range("A$6:$BQ$" & lastrow).AutoFilter field:=57, Criteria1:=">=" & DateValue(startDate), Operator:=xlAnd, Criteria2:="<=" & DateValue(endDate), Operator:=xlAnd
    End Select
End With

End Sub

在UserForm上添加动态创建按钮的代码时，CreateEventProc失败

1 个答案: