[VBA] クラスを利用するメリットと方法について & 簡単なサンプル（１）

 1Private percentVal As Variant
 2
 3'**************************
 4'*Setter
 5'**************************
 6Public Property Let percent(ByVal v As Long)
 7    If v < 0 Or 100 < v Then percentVal = Null: Exit Property
 8    percentVal = v
 9End Property
10

1Option Explicit
2
3'**************************
4'*TableCreater
5'**************************
6

 1Option Explicit
 2
 3'**************************
 4'*TableCreater
 5'**************************
 6
 7
 8'定数
 9Private Const HEADER_COLOR = 15917529 'ヘッダーセルの色
10
11'変数
12Private myRange As Range '範囲
13Private myColumnSubTotal As Long '小計列番号
14
15
16'******************************************************************************************
17'*getter/setter
18'******************************************************************************************
19
20
21Public Property Set Range(ByVal pRng As Range)
22    Set myRange = pRng
23End Property
24
25
26Public Property Let ColumnSubTotal(ByVal num As Long)
27    '範囲変数が設定されていない状態で呼出は禁止
28    If myRange Is Nothing Then Err.Raise 1000, , "範囲が設定されていません。"
29    '引数が範囲オブジェクトの列番号より外の列の番号であればエラー
30    If num < myRange.EntireColumn(1).Column Or myRange.EntireColumn(myRange.EntireColumn.Count).Column < num Then Err.Raise 1001, , "列番号の指定が不正です。"
31    '値を設定
32    myColumnSubTotal = num
33End Property
34
35

 1Option Explicit
 2
 3'**************************
 4'*TableCreater
 5'**************************
 6
 7
 8'～～略～～
 9
10'******************************************************************************************
11'*関数名    ：Class_Initialize
12'*機能      ：
13'*引数      ：
14'******************************************************************************************
15Private Sub Class_Initialize()
16    
17    '定数
18    Const FUNC_NAME As String = "Class_Initialize"
19    
20    '変数
21    
22    On Error GoTo ErrorHandler
23    
24    '本クラスでは特にやることはない。
25
26ExitHandler:
27
28    Exit Sub
29    
30ErrorHandler:
31
32    MsgBox "エラーが発生したため、マクロを終了します。" & _
33           vbLf & _
34           "関数名：" & FUNC_NAME & _
35           vbLf & _
36           "エラー番号：" & Err.Number & vbNewLine & _
37           Err.Description, vbCritical, "TableCreater"
38        
39    GoTo ExitHandler
40        
41End Sub

  1Option Explicit
  2
  3'**************************
  4'*TableCreater
  5'**************************
  6
  7
  8'～～略～～
  9
 10
 11'******************************************************************************************
 12'*関数名    ：drawLines
 13'*機能      ：罫線を引く
 14'*引数      ：
 15'*戻り値    ：True > 正常終了、False > 異常終了
 16'******************************************************************************************
 17Public Function drawLines() As Boolean
 18    
 19    '定数
 20    Const FUNC_NAME As String = "drawLines"
 21    
 22    '変数
 23    
 24    On Error GoTo ErrorHandler
 25
 26    drawLines = False
 27    
 28    '範囲変数が設定されていない状態で呼出は禁止
 29    If myRange Is Nothing Then Err.Raise 1000, , "範囲が設定されていません。"
 30    
 31    '罫線を引く
 32    myRange.Borders.LineStyle = xlContinuous
 33
 34    drawLines = True
 35    
 36ExitHandler:
 37
 38    Exit Function
 39    
 40ErrorHandler:
 41
 42    MsgBox "エラーが発生したため、マクロを終了します。" & _
 43           vbLf & _
 44           "関数名：" & FUNC_NAME & _
 45           vbLf & _
 46           "エラー番号：" & Err.Number & vbNewLine & _
 47           Err.Description, vbCritical, "TableCreater"
 48        
 49    GoTo ExitHandler
 50        
 51End Function
 52
 53
 54'******************************************************************************************
 55'*関数名    ：setStyleForHeader
 56'*機能      ：ヘッダーの強調のためのスタイル変更を行う
 57'               ヘッダーは与えられた範囲の一行目のセルとする
 58'*引数      ：
 59'*戻り値    ：True > 正常終了、False > 異常終了
 60'******************************************************************************************
 61Public Function setStyleForHeader() As Boolean
 62    
 63    '定数
 64    Const FUNC_NAME As String = "setStyleForHeader"
 65    
 66    '変数
 67    
 68    On Error GoTo ErrorHandler
 69
 70    setStyleForHeader = False
 71    
 72    '範囲変数が設定されていない状態で呼出は禁止
 73    If myRange Is Nothing Then Err.Raise 1000, , "範囲が設定されていません。"
 74    
 75    'スタイル変更
 76    With myRange.Rows(1)
 77        '範囲の一行目のセルの色を変更
 78        .Interior.color = HEADER_COLOR
 79        '範囲の一行目を太字にする
 80        .Font.Bold = True
 81        '範囲の一行目を中央揃えにする
 82        .HorizontalAlignment = xlCenter
 83    End With
 84        
 85    
 86    setStyleForHeader = True
 87    
 88    
 89ExitHandler:
 90
 91    Exit Function
 92    
 93ErrorHandler:
 94
 95    MsgBox "エラーが発生したため、マクロを終了します。" & _
 96           vbLf & _
 97           "関数名：" & FUNC_NAME & _
 98           vbLf & _
 99           "エラー番号：" & Err.Number & vbNewLine & _
100           Err.Description, vbCritical, "TableCreater"
101        
102    GoTo ExitHandler
103        
104End Function
105
106
107
108
109'******************************************************************************************
110'*関数名    ：calcTotalFromSubTotal
111'*機能      ：小計列から合計を計算し出力する
112'*引数      ：
113'*戻り値    ：True > 正常終了、False > 異常終了
114'******************************************************************************************
115Public Function calcTotalFromSubTotal() As Boolean
116    
117    '定数
118    Const FUNC_NAME As String = "calcTotalFromSubTotal"
119    
120    '変数
121    Dim sumVal As Long
122    Dim cell As Range
123    Dim subTotalOrder As Long
124    
125    On Error GoTo ErrorHandler
126
127    calcTotalFromSubTotal = False
128    
129    '範囲変数が設定されていない状態で呼出は禁止
130    If myRange Is Nothing Then Err.Raise 1000, , "範囲が設定されていません。"
131    '小計列が設定されていない状態で呼出は禁止
132    If myColumnSubTotal = 0 Then Err.Raise 1002, , "小計列が設定されていません。"
133        
134    '小計列が範囲の列の何番目であるかを算出
135    subTotalOrder = myColumnSubTotal - myRange(1).Column + 1
136        
137    '合計値計算（ヘッダー列は含まない）
138    For Each cell In myRange.Columns(subTotalOrder).Cells.Offset(1).Resize(myRange.Columns(subTotalOrder).Cells.Offset(1).Cells.Count - 1)
139        '数値の場合のみ加算
140        If IsNumeric(cell.Value) Then sumVal = sumVal + cell.Value
141    Next cell
142    If sumVal = 0 Then GoTo TruePoint
143    
144    '合計値を小計列の最下端セルの下のセルに記入
145    With myRange.Columns(subTotalOrder).Rows(myRange.Columns(subTotalOrder).Cells.Count).Offset(1)
146        .Value = sumVal
147        '合計ラベルセル
148        With .Offset(, -1)
149            'ラベルを記入
150            .Value = "合計"
151            '合計ラベルセルと合計セルに罫線を引く
152            .Resize(, .Columns.Count + 1).Borders.LineStyle = xlContinuous
153        End With
154        
155    End With
156       
157TruePoint:
158       
159    calcTotalFromSubTotal = True
160    
161ExitHandler:
162
163    Exit Function
164    
165ErrorHandler:
166
167    MsgBox "エラーが発生したため、マクロを終了します。" & _
168           vbLf & _
169           "関数名：" & FUNC_NAME & _
170           vbLf & _
171           "エラー番号：" & Err.Number & vbNewLine & _
172           Err.Description, vbCritical, "TableCreater"
173        
174    GoTo ExitHandler
175        
176End Function
177

 1'******************************************************************************************
 2'*関数名    ：TestTemplateA
 3'*機能      ：原本のテンプレAについて、TableCreaterを用いて表を作成する
 4'               作成場所：新規シート
 5'*引数      ：
 6'******************************************************************************************
 7Public Sub TestTemplateA()
 8    
 9    '定数
10    Const FUNC_NAME As String = "TestTemplateA"
11    
12    '変数
13    Dim ws As Worksheet
14    Dim objTableCreater As tableCreater
15    
16    On Error GoTo ErrorHandler
17    
18    With ThisWorkbook
19        '新規シート作成
20        Set ws = .Worksheets.Add(, .Worksheets(.Worksheets.Count))
21        ws.Name = "テンプレA_" & Format(Now, "yyyymmddhhnnss")
22        
23        '原本よりテンプレをコピー
24        ws.Range(ws.Cells(2, 2), ws.Cells(9, 4)).Value = .Worksheets("原本").Range(.Worksheets("原本").Cells(2, 2), .Worksheets("原本").Cells(9, 4)).Value
25        
26        'TableCreaterをオブジェクト化
27        Set objTableCreater = New tableCreater
28        '範囲と小計列を設定
29        Set objTableCreater.Range = ws.Range(ws.Cells(2, 2), ws.Cells(9, 4))
30        objTableCreater.ColumnSubTotal = 4
31        
32        '罫線を引く 異常終了時はExitHandler（終了処理）に移行
33        If Not objTableCreater.drawLines Then GoTo ExitHandler
34         
35        'ヘッダーの強調のためのスタイル変更を行う 異常終了時はExitHandler（終了処理）に移行
36        If Not objTableCreater.setStyleForHeader Then GoTo ExitHandler
37        
38        '小計から合計を計算 異常終了時はExitHandler（終了処理）に移行
39        If Not objTableCreater.calcTotalFromSubTotal Then GoTo ExitHandler
40        
41        '列幅の調整
42        ws.Range(ws.Cells(2, 2), ws.Cells(9, 4)).EntireColumn.AutoFit
43        
44    End With
45    
46
47ExitHandler:
48    
49    '変数を解放
50    Set objTableCreater = Nothing
51    Set ws = Nothing
52    
53    Exit Sub
54    
55ErrorHandler:
56
57    MsgBox "エラーが発生したため、マクロを終了します。" & _
58           vbLf & _
59           "関数名：" & FUNC_NAME & _
60           vbLf & _
61           "エラー番号：" & Err.Number & vbNewLine & _
62           Err.Description, vbCritical, "TableCreater"
63        
64    GoTo ExitHandler
65        
66End Sub