ユーザーフォームに新規にコントロールを追加してクラスでイベントをキャッチする例

*********  ButtonEventClassクラスのコード  ************

'ButtonEventClass

Private WithEvents tgtCtrl As MSForms.CommandButton


Public Sub SetCtrl(new_ctrl As MSForms.CommandButton)
  Set tgtCtrl = new_ctrl
End Sub


Private Sub tgtCtrl_Click() '数量変更
  MsgBox "コントロール名: " & tgtCtrl.Name
End Sub



*********  標準モジュールのコード  ******************


'Form1
'Height 492
'width 353.25
'
'MultiPage1
'Height 420
'Width 341.25

'Page1Title
'Height 18.75
'width 75
'Top 3.75
'Left 3.75

Private arrCtrl() As ButtonEventClass
Private ctrlCount As Long

'お気に入り1ページにコントロールを追加する
Public Sub AddControlPage1()

Dim xObj As Object
Dim startTop As Double

Erase arrCtrl
ReDim arrCtrl(0)
ctrlCount = 0

Load Form1

Set xObj = Form1.MultiPage1.Page1
startTop = 0

Call Kinou1(xObj, startTop)
Call Kinou2(xObj, startTop)
Call Kinou3(xObj, startTop)
Call Kinou4(xObj, startTop)
Call Kinou5(xObj, startTop)
Call Kinou6(xObj, startTop)


Form1.Show

'MsgBox Form1.MultiPage1.Page1.K2Combo.Text

End Sub



'****　機能1  ************************
Private Sub Kinou1(ByRef pageObj As Object, ByRef startTop As Double)

Dim newLabel As MSForms.Label
Dim newButton As MSForms.CommandButton

Set newLabel = pageObj.Controls.Add("Forms.Label.1", "K1BaseLabel")
With newLabel
  .Caption = ""
  .Height = 33.75
  .Width = 322.5
  .Top = 30 + startTop
  .Left = 7.5
End With

Set newLabel = pageObj.Controls.Add("Forms.Label.1", "K1TitleLabel")
With newLabel
  .Caption = "機能1"
  .Font.Name = "メイリオ"
  .Font.Size = 11
  .Height = 18.75
  .Width = 45
  .Top = 38 + startTop
  .Left = 18.75
End With

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K1StartBtn")
With newButton
  .Caption = "START"
  .Font.Name = "メイリオ"
  .Font.Size = 11
  .Height = 25
  .Width = 48.75
  .Top = 33.75 + startTop
  .Left = 255
  .BackColor = RGB(255, 192, 128)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

startTop = startTop + 45

End Sub


'****　機能2  ************************
Private Sub Kinou2(ByRef pageObj As Object, ByRef startTop As Double)

Dim newLabel As MSForms.Label
Dim newCombo As MSForms.ComboBox
Dim newButton As MSForms.CommandButton

Set newLabel = pageObj.Controls.Add("Forms.Label.1", "K2BaseLabel")
With newLabel
  .Caption = ""
  .Height = 33.75
  .Width = 322.5
  .Top = 30 + startTop
  .Left = 7.5
End With

Set newLabel = pageObj.Controls.Add("Forms.Label.1", "K2TitleLabel")
With newLabel
  .Caption = "機能2"
  .Font.Name = "メイリオ"
  .Font.Size = 11
  .Height = 18.75
  .Width = 45
  .Top = 38 + startTop
  .Left = 18.75
End With

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K2StartBtn")
With newButton
  .Caption = "START"
  .Font.Name = "メイリオ"
  .Font.Size = 11
  .Height = 25
  .Width = 48.75
  .Top = 33.75 + startTop
  .Left = 255
  .BackColor = RGB(255, 192, 128)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

Set newCombo = pageObj.Controls.Add("Forms.ComboBox.1", "K2Combo")
With newCombo
  .Font.Size = 10
  .Height = 17
  .Width = 71.25
  .Top = 37.5 + startTop
  .Left = 127.5
  .List = Array("AAA", "BBB")
  .ListIndex = 0
End With

startTop = startTop + 45

End Sub


'****　機能3  ************************
Private Sub Kinou3(ByRef pageObj As Object, ByRef startTop As Double)

Dim newLabel As MSForms.Label
Dim newCombo As MSForms.ComboBox
Dim newButton As MSForms.CommandButton

Set newLabel = pageObj.Controls.Add("Forms.Label.1", "K3BaseLabel")
With newLabel
  .Caption = ""
  .Height = 45
  .Width = 322.5
  .Top = 30 + startTop
  .Left = 7.5
End With

Set newLabel = pageObj.Controls.Add("Forms.Label.1", "K3TitleLabel")
With newLabel
  .Caption = "機能3"
  .Font.Name = "メイリオ"
  .Font.Size = 11
  .Height = 18.75
  .Width = 45
  .Top = 45 + startTop
  .Left = 18.75
End With

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K3StartBtn")
With newButton
  .Caption = "START"
  .Font.Name = "メイリオ"
  .Font.Size = 11
  .Height = 25
  .Width = 48.75
  .Top = 40 + startTop
  .Left = 255
  .BackColor = RGB(255, 192, 128)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

Set newCombo = pageObj.Controls.Add("Forms.ComboBox.1", "K3Combo1")
With newCombo
  .Font.Size = 10
  .Height = 17
  .Width = 71.25
  .Top = 33.75 + startTop
  .Left = 127.5
  .List = Array("1000", "2000", "3000", "4000")
  .ListIndex = 0
End With

Set newCombo = pageObj.Controls.Add("Forms.ComboBox.1", "K3Combo2")
With newCombo
  .Font.Size = 10
  .Height = 17
  .Width = 71.25
  .Top = 55 + startTop
  .Left = 127.5
  .List = Array("0:00", "1:00", "2:00", "3:00")
  .ListIndex = 0
End With

startTop = startTop + 56

End Sub


'****　機能4  ************************
Private Sub Kinou4(ByRef pageObj As Object, ByRef startTop As Double)

Dim newLabel As MSForms.Label
Dim newOption As MSForms.OptionButton
Dim newCheck As MSForms.CheckBox
Dim newButton As MSForms.CommandButton

Set newLabel = pageObj.Controls.Add("Forms.Label.1", "K4BaseLabel")
With newLabel
  .Caption = ""
  .Height = 45
  .Width = 322.5
  .Top = 30 + startTop
  .Left = 7.5
End With

Set newLabel = pageObj.Controls.Add("Forms.Label.1", "K4TitleLabel")
With newLabel
  .Caption = "機能4"
  .Font.Name = "メイリオ"
  .Font.Size = 11
  .Height = 18.75
  .Width = 45
  .Top = 45 + startTop
  .Left = 18.75
End With

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K4StartBtn")
With newButton
  .Caption = "START"
  .Font.Name = "メイリオ"
  .Font.Size = 11
  .Height = 25
  .Width = 48.75
  .Top = 40 + startTop
  .Left = 255
  .BackColor = RGB(255, 192, 128)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

Set newOption = pageObj.Controls.Add("Forms.OptionButton.1", "K4Option1")
With newOption
  .Caption = "KKK"
  .GroupName = "K4GroupKeiki"
  .Font.Size = 10
  .Height = 17.25
  .Width = 71.25
  .Top = 34 + startTop
  .Left = 82.5
  .Value = True
End With

Set newOption = pageObj.Controls.Add("Forms.OptionButton.1", "K4Option2")
With newOption
  .Caption = "FFF"
  .GroupName = "K4GroupKeiki"
  .Font.Size = 10
  .Height = 17.25
  .Width = 71.25
  .Top = 54 + startTop
  .Left = 82.5
End With

Set newCheck = pageObj.Controls.Add("Forms.CheckBox.1", "K4Check1")
With newCheck
  .Caption = "注意"
  .Font.Size = 10
  .Height = 18.75
  .Width = 78.75
  .Top = 34 + startTop
  .Left = 135
End With

Set newCheck = pageObj.Controls.Add("Forms.CheckBox.1", "K4Check2")
With newCheck
  .Caption = "メモ"
  .Font.Size = 10
  .Height = 18.75
  .Width = 78.75
  .Top = 54 + startTop
  .Left = 135
End With

startTop = startTop + 56

End Sub


'****　機能5  ************************
Private Sub Kinou5(ByRef pageObj As Object, ByRef startTop As Double)

Dim newLabel As MSForms.Label
Dim newButton As MSForms.CommandButton

Set newLabel = pageObj.Controls.Add("Forms.Label.1", "K5BaseLabel")
With newLabel
  .Caption = ""
  .Height = 33.75
  .Width = 322.5
  .Top = 30 + startTop
  .Left = 7.5
End With

Set newLabel = pageObj.Controls.Add("Forms.Label.1", "K5TitleLabel")
With newLabel
  .Caption = "機能5"
  .Font.Name = "メイリオ"
  .Font.Size = 11
  .Height = 18.75
  .Width = 45
  .Top = 38 + startTop
  .Left = 18.75
End With

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K5Btn1")
With newButton
  .Caption = "1"
  .Font.Name = "メイリオ"
  .Font.Size = 12
  .Font.Bold = True
  .ForeColor = RGB(255, 255, 255)
  .Height = 25
  .Width = 25
  .Top = 34.25 + startTop
  .Left = 60
  .BackColor = RGB(0, 64, 0)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K5Btn2")
With newButton
  .Caption = "2"
  .Font.Name = "メイリオ"
  .Font.Size = 12
  .Font.Bold = True
  .ForeColor = RGB(255, 255, 255)
  .Height = 25
  .Width = 25
  .Top = 34.25 + startTop
  .Left = 86.25
  .BackColor = RGB(0, 64, 0)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K5Btn3")
With newButton
  .Caption = "3"
  .Font.Name = "メイリオ"
  .Font.Size = 12
  .Font.Bold = True
  .ForeColor = RGB(255, 255, 255)
  .Height = 25
  .Width = 25
  .Top = 34.25 + startTop
  .Left = 112.5
  .BackColor = RGB(0, 64, 0)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K5Btn4")
With newButton
  .Caption = "4"
  .Font.Name = "メイリオ"
  .Font.Size = 12
  .Font.Bold = True
  .ForeColor = RGB(255, 255, 255)
  .Height = 25
  .Width = 25
  .Top = 34.25 + startTop
  .Left = 138.75
  .BackColor = RGB(0, 64, 0)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K5Btn5")
With newButton
  .Caption = "5"
  .Font.Name = "メイリオ"
  .Font.Size = 12
  .Font.Bold = True
  .ForeColor = RGB(255, 255, 255)
  .Height = 25
  .Width = 25
  .Top = 34.25 + startTop
  .Left = 165
  .BackColor = RGB(0, 64, 0)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K5Btn6")
With newButton
  .Caption = "6"
  .Font.Name = "メイリオ"
  .Font.Size = 12
  .Font.Bold = True
  .ForeColor = RGB(255, 255, 255)
  .Height = 25
  .Width = 25
  .Top = 34.25 + startTop
  .Left = 191.25
  .BackColor = RGB(0, 64, 0)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K5Btn7")
With newButton
  .Caption = "7"
  .Font.Name = "メイリオ"
  .Font.Size = 12
  .Font.Bold = True
  .ForeColor = RGB(255, 255, 255)
  .Height = 25
  .Width = 25
  .Top = 34.25 + startTop
  .Left = 217.5
  .BackColor = RGB(0, 64, 0)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K5Btn8")
With newButton
  .Caption = "8"
  .Font.Name = "メイリオ"
  .Font.Size = 12
  .Font.Bold = True
  .ForeColor = RGB(255, 255, 255)
  .Height = 25
  .Width = 25
  .Top = 34.25 + startTop
  .Left = 243.75
  .BackColor = RGB(0, 64, 0)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K5Btn9")
With newButton
  .Caption = "9"
  .Font.Name = "メイリオ"
  .Font.Size = 12
  .Font.Bold = True
  .ForeColor = RGB(255, 255, 255)
  .Height = 25
  .Width = 25
  .Top = 34.25 + startTop
  .Left = 270
  .BackColor = RGB(0, 64, 0)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K5Btn10")
With newButton
  .Caption = "10"
  .Font.Name = "メイリオ"
  .Font.Size = 12
  .Font.Bold = True
  .ForeColor = RGB(255, 255, 255)
  .Height = 25
  .Width = 25
  .Top = 34.25 + startTop
  .Left = 296.25
  .BackColor = RGB(0, 64, 0)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

startTop = startTop + 45

End Sub


'****　機能6  ************************
Private Sub Kinou6(ByRef pageObj As Object, ByRef startTop As Double)

Dim newLabel As MSForms.Label
Dim newButton As MSForms.CommandButton

Set newLabel = pageObj.Controls.Add("Forms.Label.1", "K6BaseLabel")
With newLabel
  .Caption = ""
  .Height = 33.75
  .Width = 322.5
  .Top = 30 + startTop
  .Left = 7.5
End With

Set newLabel = pageObj.Controls.Add("Forms.Label.1", "K6TitleLabel")
With newLabel
  .Caption = "機能6"
  .Font.Name = "メイリオ"
  .Font.Size = 11
  .Height = 18.75
  .Width = 45
  .Top = 38 + startTop
  .Left = 18.75
End With

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K6RendaBtn")
With newButton
  .Caption = "YYY"
  .Font.Name = "メイリオ"
  .Font.Size = 11
  .Height = 25
  .Width = 48.75
  .Top = 34.15 + startTop
  .Left = 105
  .BackColor = RGB(192, 192, 255)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K6JunkaiBtn")
With newButton
  .Caption = "OOO"
  .Font.Name = "メイリオ"
  .Font.Size = 11
  .Height = 25
  .Width = 48.75
  .Top = 34.15 + startTop
  .Left = 161.25
  .BackColor = RGB(71, 177, 98)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

Set newButton = pageObj.Controls.Add("Forms.CommandButton.1", "K6JunkaiBtn")
With newButton
  .Caption = "GHJ"
  .Font.Name = "メイリオ"
  .Font.Size = 11
  .Height = 25
  .Width = 48.75
  .Top = 34.15 + startTop
  .Left = 161.25
  .BackColor = RGB(71, 177, 98)
End With
Set arrCtrl(ctrlCount) = New ButtonEventClass
arrCtrl(ctrlCount).SetCtrl newButton
ReDim Preserve arrCtrl(UBound(arrCtrl) + 1)
ctrlCount = ctrlCount + 1

startTop = startTop + 45

End Sub