自分用のメモなので、形は整ってないです。
WithEventsで、クラスに登録したイベントを、シートやユーザフォームから発動させる例
あまり洗練されてないかも。参考程度に
クラス1.xlsm MoveIndicatorClassクラス
**************** MoveIndicatorClass **********************
Option Explicit
Private innerValue As Long
Public Event Change(current As Long, previous As Long)
'イベントの宣言
Sub Init(num As Long)
innerValue = num
End Sub
Property Get Value() As Long
Value = innerValue
End Property
Property Let Value(num As Long)
Dim previous As Long
previous = innerValue
innerValue = num
RaiseEvent Change(innerValue, previous)
'イベントの発動
End Property
Sub MoveNext()
Value = innerValue + 1
End Sub
Sub MovePrevious()
Value = innerValue - 1
End Sub
******************* シート1のコード ****************************
Option Explicit
Private WithEvents clsMIC As MoveIndicatorClass
'MoveIndicatorClassのイベントプロシージャと結びつける
'標準モジュールではこの宣言はできないらしい。シートのコードか、ユーザフォームなどは可能
' *********** 以下は、ボタンのイベント **********************
Private Sub Initialize_Click() '初期化処理ボタンを押した時
'リンク先のコードには以下の部分が無いが、前の★が残ったままになるので追加
If Not clsMIC Is Nothing Then
シート1.Range("A" & clsMIC.Value).ClearContents
Set clsMIC = Nothing
End If
Set clsMIC = New MoveIndicatorClass
clsMIC.Init 1 '1行目にカーソルを初期化
シート1.Range("A1").Value = "★"
End Sub
Private Sub Move_Next_Click() '下へ移動する
clsMIC.MoveNext
End Sub
Private Sub Move_Previous_Click() '上へ移動する
clsMIC.MovePrevious
End Sub
Private Sub clsMIC_Change(current As Long, previous As Long)
'MoveIndicatorClassでイベントが発動した時の処理
'「クラスのインスタンス名_クラスで宣言したイベント名」がプロシージャ名になる
シート1.Range("A" & previous).ClearContents '前の★を消去
シート1.Range("A" & current).Value = "★"
End Sub
'Initialize_Click() Move_Next_Click() Move_Previous_Click()の3つだけに処理を記述しても実現できるが、
'他にも同じような処理をするシートがある場合は、クラスを使ったほうがいいだろう
クラスの基本
※ クラス1.xlsm BasicClassクラス Module1
******************** BasicClass *************************
Option Explicit
'クラスのプロパティはカプセル化で隠蔽するのが一般的だが、しなくても動作はする
Private pLong As Long 'プロパティ Privateで宣言するのが普通
Private pString As String
Private pWS As Worksheet
Private pWB As Workbook
Private pRange As Range
Private pObj As Object
'********** Get Let(Set) JavaのSetter、Getterに相当する。カプセル化のため ******
Public Property Get LongData() As Long
'クラスのプロパティを取得するメソッド メソッド名は任意だが、取得する変数の型を記述
'クラス外から利用できるようにするため、Publicにする
LongData = pLong 'これでpLongの内容を取得
End Property
Public Property Let LongData(ByVal num As Long)
'クラスのプロパティを設定するメソッド メソッド名は任意だが、Getと同名にするのが普通
pLong = num 'これでpLongの値を設定
End Property
'pString
Public Property Get StringData() As String
StringData = pString
End Property
Public Property Let StringData(ByVal str1 As String)
pString = str1
End Property
'pWS
Public Property Get WorksheetData() As Worksheet
Set WorksheetData = pWS
'オブジェト型は、Setで格納
End Property
Public Property Set WorksheetData(ByRef ws As Worksheet)
Set pWS = ws
End Property
'pWB
Public Property Get WorkbookData() As Workbook
Set WorkbookData = pWB
End Property
Public Property Set WorkbookData(ByRef wb As Workbook)
Set pWB = wb
End Property
'pRange
Public Property Get RangeData() As Range
Set RangeData = pRange
End Property
Public Property Set RangeData(ByRef range1 As Range)
Set pRange = range1
End Property
'pObj
Public Property Get ObjectData() As Object
Set ObjectData = pObj
End Property
Public Property Set ObjectData(ByRef obj As Object)
Set pObj = obj
End Property
'pRangeのセル範囲の背景色を変更するメソッド
Public Sub ChangeRangeColor()
If Not pRange Is Nothing Then 'pRangeがまだSetされていない場合は処理なし
pRange.Interior.ColorIndex = 5
End If
End Sub
'クラスのインスタンスが生成された時に実行。コンストラクタみたいなものか
'プロパティに初期値を設定するのに使える
Private Sub Class_Initialize()
pLong = 999
Debug.Print "インスタンス生成 pLongの値:" & pLong
End Sub
'クラスのインスタンスが破棄された時に実行
'いつ破棄されるかは不明確 Set Nothing で破棄されている?
Private Sub Class_Terminate()
Debug.Print "インスタンス破棄"
End Sub
************* Module1 **************
Sub Use_BasicClass() '基本的なクラスを利用する
Dim clsBC As BasicClass ' BasicClass型として宣言
Set clsBC = New BasicClass ' BasicClassのインスタンスを生成
Dim xFSO As Object
Set xFSO = CreateObject("Scripting.FileSystemObject")
With clsBC
.LongData = 123 ' pLongプロパティの値を設定
Debug.Print .LongData 'これでpLongプロパティの値を取得 123
.StringData = "日本晴れ"
Debug.Print .StringData ' "日本晴れ"
Set .WorksheetData = シート2 ' オブジェクト型なのでSetで
Debug.Print .WorksheetData.Name ' "シート2"
Set .WorkbookData = ThisWorkbook
Debug.Print .WorkbookData.Worksheets.Count ' 3 後々変化するが
Set .RangeData = シート2.Range("B2:C10")
Debug.Print .RangeData.Cells(1, 1).Address '$B$2
Set .ObjectData = xFSO
Debug.Print VarType(.ObjectData) '9 オブジェクト型
.ChangeRangeColor
'pRangeプロパティに設定されているセル範囲の背景色を青に変更するメソッドを呼び出し
End With
Set clsBC = Nothing
'クラスのインスタンスを削除。あまり意味無いかも
'一応、クラスのClass_Terminate()は実行されているみたい
Debug.Print "Set Nothing"
Set xFSO = Nothing
End Sub
シートのイベントをクラスで一括管理する
シート数が多い場合はかなり強力かも
※ クラス1.xlsm SheetEventClassクラス シート2、シート3
*************************** SheetEventClass ************************************
Option Explicit
'シートのコードで生成したインスタンスがあるうちは、pWorksheetやcurrentRangeの内容は保持される
'そのことを利用して、選択セル範囲が変わるたびに、前の選択範囲は無色に戻している
Private WithEvents pWorksheet As Worksheet 'ワークシートのイベントを宣言
Private currentRange As Range '現在選択されているセル範囲
'SetとGetメソッド 同名にしておこう
Public Property Set WorksheetObj(ByRef ws As Worksheet)
Set pWorksheet = ws
End Property
Public Property Get WorksheetObj() As Worksheet
Set WorksheetObj = pWorksheet
End Property
Private Sub Class_Initialize() 'インスタンスが作成された時の処理
'必要なら何らかの処理を
End Sub
Private Sub pWorksheet_SelectionChange(ByVal Target As Range)
'選択範囲が変わった時のイベント
'メソッド名は、「イベントの変数名_シートのイベント名」になる
'引数もシートのイベントのプロシージャと同じにしないと駄目
If Not currentRange Is Nothing Then
'currentRangeがNothingではない場合は、すでに背景色を青にしている範囲があるので、それを無色に
currentRange.Interior.ColorIndex = 0
End If
Set currentRange = Target 'currentRangeを、Targetで渡された範囲に変更
Target.Interior.ColorIndex = 5 '範囲のセルの背景色を青に
'行全体・列全体を選択した時も、全て青になる。結構使える?
End Sub
Private Sub pWorksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
' シート内でダブルクリックされた時の処理
MsgBox Target.Cells(1, 1).Row & "行" & Target.Cells(1, 1).Column & "列"
'ダブルクリックしたセルの行番号と列番号を出力
End Sub
'※他のイベントも同様に追加していけばいいだろう。全てのイベントに対応しているのかどうかは不明だが
*************************** シート2のコード ************************************
Option Explicit
' シートのイベントを、SheetEventClassクラスで管理する
Private clsSE As SheetEventClass
Private Sub Worksheet_Activate() 'シートがアクティブになった時
If clsSE Is Nothing Then
'まだSheetEventClassのインスタンスが作成されていない場合は、インスタンス作成
'一度インスタンスが作成されれば、明示的に破棄するか、ブックを閉じるまで残るようだ
Set clsSE = New SheetEventClass
Set clsSE.WorksheetObj = Me
'SheetEventClassのpWorksheetプロパティに、このシートをSet
Me.Cells.Interior.ColorIndex = 0 'シート全体の背景色を無色にする
End If
End Sub
*************************** シート3のコード ************************************
Option Explicit
'シート2と全く同じコードで、同じ動作になる。これがクラスでのイベント管理の長所
Private clsSE As SheetEventClass
Private Sub Worksheet_Activate()
If clsSE Is Nothing Then
Set clsSE = New SheetEventClass
Set clsSE.WorksheetObj = Me
Me.Cells.Interior.ColorIndex = 0
End If
End Sub
ブックのイベントをクラスで一括管理する
ブックは1つだけなので、あまり意味は無いかも。複数のブックの管理ができれば別だが
※ クラス1.xlsm BookEventClassクラス
*********************** BookEventClass ****************************************
Option Explicit
Private WithEvents pWorkbook As Workbook 'ブックのイベントを宣言
'SetとGetメソッド 同名にしておこう
Public Property Set WorkbookObj(ByRef wb As Workbook)
Set pWorkbook = wb
End Property
Public Property Get WorkbookObj() As Workbook
Set WorkbookObj = pWorkbook
End Property
Private Sub Class_Initialize() 'インスタンスが作成された時の処理
'必要なら何らかの処理を
End Sub
Private Sub pWorkbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'シートの内容が変わった時のイベント(多分セルの値)
'メソッド名は、「イベントの変数名_ブックのイベント名」になる
'引数もブックのイベントのプロシージャと同じにしないと駄目
MsgBox Sh.Name 'シート名を出力
End Sub
Private Sub pWorkbook_WindowResize(ByVal Wn As Window)
'ウィンドウサイズが変更された時の処理
MsgBox Wn.Height 'ウィンドウの高さを出力
End Sub
'※他のイベントも同様に追加していけばいいだろう。全てのイベントに対応しているのかどうかは不明だが
'ブックのイベントは、クラスで管理する意味はあまり無いかも
*********************** ブックのコード ****************************************
Option Explicit
' ブックのイベントを、BookEventClassクラスで管理する
Private clsBE As BookEventClass
Private Sub Workbook_Open() 'ブックを開いた時の処理
If clsBE Is Nothing Then
'まだBookEventClassのインスタンスが作成されていない場合は、インスタンス作成
'一度インスタンスが作成されれば、明示的に破棄するか、ブックを閉じるまで残るようだ
Set clsBE = New BookEventClass
Set clsBE.WorkbookObj = Me
'BookEventClassのWorkbookObjプロパティに、このブックをSet
End If
End Sub
クラスでユーザーフォームのイベントを一括管理する
※ クラス1.xlsm FormEventClassクラス FormEventフォーム
*********************** FormEventClass ****************************************
Option Explicit
Private pForm As MSForms.UserForm 'コントロールの親であるフォーム
Private pControl As MSForms.Control '対象となるコントロールオブジェクト
Private WithEvents pCheckBox As MSForms.CheckBox
'イベントを発生させるチェックボックスオブジェクト
Private WithEvents pTextBox As MSForms.TextBox 'テキストボックスオブジェクト
Private WithEvents pComboBox As MSForms.ComboBox 'コンボボックスオブジェクト
Private WithEvents pOptionButton As MSForms.OptionButton 'オプションボタンオブジェクト
Private WithEvents pListBox As MSForms.ListBox 'リストボックスオブジェクト
Private WithEvents pCommandButton As MSForms.CommandButton 'コマンドボタンボタンオブジェクト
'※他のコントロールも、必要に応じて追加で
Public Property Get Control() As MSForms.Control 'pControl取得用
Set Control = pControl
End Property
Public Property Set Control(ByVal aControl As MSForms.Control)
Set pControl = aControl 'Get用にControlで別途格納
Set pForm = aControl.Parent 'コントロールの親フォーム
Select Case TypeName(aControl) 'コントロールの種類に応じて、各コントロールオブジェクトにセット
Case "TextBox"
Set pTextBox = aControl
Case "CheckBox"
Set pCheckBox = aControl
Case "OptionButton"
Set pOptionButton = aControl
Case "ComboBox"
Set pComboBox = aControl
Case "ListBox"
Set pListBox = aControl
Case "CommandButton"
Set pCommandButton = aControl
Case Else
'※他のコントロールのプロパティも、必要に応じて追加で
End Select
End Property
'チェックボックスの値が変化した場合のイベントプロシージャ
Private Sub pCheckBox_Change()
'プロシージャ名は、「イベント変数名_イベント名」にする
pForm.Controls("lbl01").Caption = pCheckBox.Name & "の値が変更された"
End Sub
'テキストボックスの値が変化した場合のイベントプロシージャ
Private Sub pTextBox_Change()
pForm.Controls("lbl01").Caption = pTextBox.Name & "の値が変更された"
End Sub
'************** コンボボックスのみ、全てのイベントを並べてみる ***********************
Private Sub pComboBox_BeforeDragOver( _
ByVal Cancel As MSForms.ReturnBoolean, _
ByVal Data As MSForms.DataObject, _
ByVal X As Single, _
ByVal Y As Single, _
ByVal DragState As MSForms.fmDragState, _
ByVal Effect As MSForms.ReturnEffect, _
ByVal Shift As Integer)
pForm.Controls("lbl01").Caption = pComboBox.Name & "のBeforeDragOverイベント発動"
End Sub
Private Sub pComboBox_Change()
pForm.Controls("lbl01").Caption = pComboBox.Name & "のChangeイベント発動"
End Sub
Private Sub pComboBox_Click()
pForm.Controls("lbl01").Caption = pComboBox.Name & "のClickイベント発動"
End Sub
Private Sub pComboBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
pForm.Controls("lbl01").Caption = pComboBox.Name & "のDblClickイベント発動"
End Sub
Private Sub pComboBox_DropButtonClick()
pForm.Controls("lbl01").Caption = pComboBox.Name & "のDropButtonClickイベント発動"
End Sub
Private Sub pComboBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
pForm.Controls("lbl01").Caption = pComboBox.Name & "のKeyDownイベント発動"
End Sub
Private Sub pComboBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
pForm.Controls("lbl01").Caption = pComboBox.Name & "のKeyPressイベント発動"
End Sub
Private Sub pComboBox_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
pForm.Controls("lbl01").Caption = pComboBox.Name & "のKeyUpイベント発動"
End Sub
Private Sub pComboBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
pForm.Controls("lbl01").Caption = pComboBox.Name & "のMouseDownイベント発動"
End Sub
Private Sub pComboBox_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
pForm.Controls("lbl01").Caption = pComboBox.Name & "のMouseMoveイベント発動"
End Sub
Private Sub pComboBox_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
pForm.Controls("lbl01").Caption = pComboBox.Name & "のMouseUpイベント発動"
End Sub
'以下は使用不可・APIを使うと可能らしい
Private Sub pComboBox_AfterUpdate()
End Sub
Private Sub pComboBox_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, _
ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, _
ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, _
ByVal Shift As Integer)
End Sub
Private Sub pComboBox_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
End Sub
Private Sub pComboBox_Enter()
End Sub
Private Sub pComboBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
End Sub
*********************** FormEventフォーム ****************************************
Option Explicit
'FormEventに登録してあるイベントで、コンボボックスは多数のイベントが
'発生する度に、ラベルの内容が変化する
'コンボボックスの値を変更してみると分かる
Private colEvent As New Collection 'FormEventクラスのコレクション
Private Sub UserForm_Initialize()
'FormEventクラスのインスタンスを作成しコレクションに追加
Dim clsEvent As FormEvent
Dim ctl As MSForms.Control
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox", _
"CheckBox", _
"OptionButton", _
"ComboBox", _
"ListBox", _
"CommandButton"
Set clsEvent = New FormEvent
Set clsEvent.Control = ctl
colEvent.Add clsEvent
Case Else
'※他のコントロールも、必要に応じて追加で
End Select
Next
'コンボボックスのリストを設定
Dim i As Long
For i = 1 To 5
Me.cmb01.AddItem i
Next i
End Sub
クラスを利用して、入力支援やバリデーションの機能を使う
よく使うデータパターンの場合は、クラスに登録したほうが汎用性が高い
※ クラス1.xlsm UsersClassクラス Module1
********************** ************************
Option Explicit
Private pName As String
Private pAge As String
Private reg As Variant '正規表現用
Private Sub Class_Initialize() 'インスタンス生成時
Set reg = CreateObject("VBScript.RegExp")
'正規表現用のオブジェクトを生成。オブジェクト生成は、ここでしたほうがいいかな
End Sub
Private Sub Class_Terminate() 'インスタンス破棄時
Set reg = Nothing
End Sub
'Get Set Let
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Name(ByVal aName As String)
If validateName(aName) Then 'aNameのバリデーションをする関数を呼び出し
pName = aName
Else
pName = "" 'Falseの場合は、空文字を設定する
End If
End Property
Public Property Get Age() As String
Age = pAge
End Property
Public Property Let Age(ByVal aAge As String)
If validateAge(aAge) Then 'aAgeのバリデーションをする関数を呼び出し
pAge = aAge
Else
pAge = -1 'Falseの場合は、-1を設定する
End If
End Property
'バリデーション関数
Private Function validateName(ByVal aName As String) As Boolean
validateName = True
If Len(aName) > 20 Then '20文字を超えるNameは拒否する
validateName = False
Exit Function
End If
With reg
.Global = True
.IgnoreCase = False
.Pattern = "[a-zA-Z0-9]" 'Nameに半角英数字は入らないものとする
If .test(aName) = True Then
validateName = False
Exit Function
End If
End With
End Function
Private Function validateAge(ByVal Age As Long) As Boolean
If Age > 120 Or Age < 0 Then '120才以下0才以上ではない場合
validateAge = False
Else
validateAge = True
End If
End Function
*********************** Module1 *************************
Sub Use_USersClass() 'UsersClassを利用して、入力補正やバリデーション機能を使う
Dim claUC As UsersClass
Set claUC = New UsersClass
' claUC. まで入力すれば、自動候補で入力がしやすい
'NameとAgeは、クラス側でバリデーション機能を持たせているので、標準モジュールには必要なくなる
claUC.Name = "長い名前長い名前長い名前長い名前長い名前長い名前長い名前長い名前"
If claUC.Name = "" Then
MsgBox "Nameの値が不正です"
End If
claUC.Name = "TOM"
If claUC.Name = "" Then
MsgBox "Nameの値が不正です"
End If
claUC.Age = 500
If claUC.Age < 0 Then
MsgBox "Ageの値が不正です"
End If
Set claUC = Nothing
End Sub
クラスを使って、表形式のデータを管理する例
フォーマットが決まっている表の場合は使える方法だと思う
※クラス1.xlsm Staffクラス Staffsクラス Modile1 Use_Staff_And_Staffs1() Use_Staff_And_Staffs2()
**************** Staff ************************************
Option Explicit
Private pStaffCode As String
Private pName As String
Private pAge As Long
Private pMobile As String
Public Property Get StaffCode() As String
StaffCode = pStaffCode
End Property
Public Property Let StaffCode(ByVal aStaffCode As String)
pStaffCode = aStaffCode
End Property
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Name(ByVal aName As String)
pName = aName
End Property
Public Property Get Age() As Long
Age = pAge
End Property
Public Property Let Age(ByVal aAge As Long)
pAge = aAge
End Property
Public Property Get Mobile() As String
Mobile = pMobile
End Property
Public Property Let Mobile(ByVal aMobile As String)
pMobile = aMobile
End Property
**************** Staffs ************************************
Option Explicit
Private pItems As Collection 'StaffクラスのインスタンスのCollection
Private pItemDictionary As Object
Private Sub Class_Initialize() '初期化時
Set pItems = New Collection
Set pItemDictionary = CreateObject("Scripting.Dictionary") 'Dictionaryオブジェクト
End Sub
Private Sub Class_Terminate() '削除時
Set pItems = Nothing
Set pItemDictionary = Nothing
End Sub
'データを追加する
Public Sub Add(ByVal aStaffCode As String, ByVal aName As String, _
ByVal aAge As Long, ByVal aMobile As String)
pItemDictionary.Add Key:=aStaffCode, Item:=pItems.Count + 1
'キーをStaffCode、値を1からの連番にする
Dim clsStaff As Staff 'Staffクラスのインスタンス
Set clsStaff = New Staff
With clsStaff
.StaffCode = aStaffCode
.Name = aName
.Age = aAge
.Mobile = aMobile
End With
pItems.Add clsStaff 'StaffクラスのインスタンスをCollectionに追加
Set clsStaff = Nothing
End Sub
'Staffクラスのインスタンスの情報を取得
Public Property Get Item(ByVal index As Long) As Staff
Set Item = pItems.Item(index)
End Property
'StaffCodeで検索し、情報が存在すればそのインデックス番号をリターン。存在しない場合は-1をリターン
Public Function SearchByStaffCode(ByVal aStaffCode As String) As Long
SearchByStaffCode = -1
If pItemDictionary.Exists(aStaffCode) Then
SearchByStaffCode = pItemDictionary.Item(aStaffCode)
End If
End Function
**************** Use_Staff_And_Staffs1() ************************************
'********** StaffクラスとStaffsクラスを使う例1 *******************
Sub Use_Staff_And_Staffs1()
Dim range1 As Range
Dim var1 As Variant
Dim clsStaffs As Staffs
Dim i As Long
シート4.Range(Cells(1, 6), Cells(11, 9)).Clear
With シート4.Cells(1, 1).CurrentRegion
Set range1 = .Resize(.Rows.Count - 1).Offset(1) '1行目は除いた範囲をセット
End With
var1 = range1.Value
Set clsStaffs = New Staffs
For i = LBound(var1) To UBound(var1)
clsStaffs.Add var1(i, 1), var1(i, 2), var1(i, 3), var1(i, 4)
'StaffsクラスのAddプロシージャでデータ追加。このコードで動作するみたい
' clsStaffs.Add(var1(i, 1), var1(i, 2), var1(i, 3), var1(i, 4)) このコードはエラー
Next i
'clsStaffsインスタンスから情報を取得
For i = 1 To 10
シート4.Cells(i + 1, 6).Value = clsStaffs.Item(i).StaffCode
'StaffsクラスのItemメソッドを利用している
シート4.Cells(i + 1, 7).Value = clsStaffs.Item(i).Name
シート4.Cells(i + 1, 8).Value = clsStaffs.Item(i).Age
シート4.Cells(i + 1, 9).Value = clsStaffs.Item(i).Mobile
Next i
Set clsStaffs = Nothing
End Sub
**************** Use_Staff_And_Staffs2() ************************************
'********** StaffクラスとStaffsクラスを使う例2 *******************
Sub Use_Staff_And_Staffs2()
Dim range1 As Range
Dim var1 As Variant
Dim clsStaffs As Staffs
Dim i As Long
With シート4.Cells(1, 1).CurrentRegion
Set range1 = .Resize(.Rows.Count - 1).Offset(1)
End With
var1 = range1.Value
Set clsStaffs = New Staffs
For i = LBound(var1) To UBound(var1)
clsStaffs.Add var1(i, 1), var1(i, 2), var1(i, 3), var1(i, 4)
Next i
Dim strStaffCode As String
Dim result As Long
strStaffCode = シート4.Cells(15, 1).Value
result = clsStaffs.SearchByStaffCode(strStaffCode) 'StaffCodeで検索する関数呼び出し
If result = -1 Then
シート4.Cells(17, 1).Value = "該当する情報なし"
シート4.Range(Cells(17, 2), Cells(17, 4)).Value = ""
Else
シート4.Cells(17, 1).Value = clsStaffs.Item(result).StaffCode
シート4.Cells(17, 2).Value = clsStaffs.Item(result).Name
シート4.Cells(17, 3).Value = clsStaffs.Item(result).Age
シート4.Cells(17, 4).Value = clsStaffs.Item(result).Mobile
End If
Set clsStaffs = Nothing
End Sub
クラスでデフォルトのプロパティを設定する
デフォルトのプロパティは、Debug.Print clsDF のように、プロパティの指定無しで取得・設定が可能になる
※クラス1.xlsm DefaultPropertyクラス
**************** DefaultProperty ************************************
Option Explicit
Private pNum As Long
Private pName As String
Private pDepartment As String
Public Property Get Num() As Long
Num = pNum
End Property
Public Property Let Num(ByVal aNum As Long)
pNum = aNum
End Property
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Name(ByVal aName As String)
pName = aName
End Property
Public Property Get Department() As Long
Department = pDepartment
End Property
Public Property Let Department(ByVal aDepartment As Long)
pDepartment = aDepartment
End Property
※上記の内容で、一旦エクスポートする
出来上がったclsファイルを開き、NumプロパティのGetだけ以下のように1文を追加
Letには何も追加しなくていい
Public Property Get Num() As Long
Attribute Value.VB_UserMemId = 0
Num = pNum
End Property
clsファイルをインポートすると、クラスのコード自体は変化しないが、デフォルトのプロパティとしてNumが設定されている
以下のような利用が可能
Dim clsDF As DefaultProperty
Set clsDF = New DefaultProperty
clsDF = 125 'プロパティを指定しなくても、Numに値を設定することになる
Debug.Print clsDF ' 125 取得もプロパティを指定なしで可能