********* 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