0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

ExcelVBA  クラス関連

Last updated at Posted at 2022-09-03

自分用のメモなので、形は整ってないです。

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  取得もプロパティを指定なしで可能
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?