[Excel VBA]ポリモーフィズムを用いて、IF文を使わずラジオボタンごとの処理分岐を行う

Nov 1, 2020 · この記事は約5分で読めます · Excel VBA 自作オブジェクト指向 ·

Share on:

概要

この記事について

VBAにおいてポリモーフィズムの考え方によりコーディングを行う一例。

CallByName関数によるポリモーフィズムの考え方と、
ラジオボタン（オプションボタン）オブジェクトのtagプロパティを用いて、
IFステートメントやSelect Caseステートメントを使わずに処理分岐を行う実装例。

説明のために作成したExcelファイルとソースコードはこちらでダウンロードできます。

作成環境

Windows10
MSOffice 2016

前提

下のような画面があり、
ラジオボタンを選択し、実行ボタンを押下することで
ラジオボタンの種類に応じた処理を行う。

名称	画像
フォーム
現在時刻を表示するラジオボタンを選択
ユーザ名を表示するラジオボタンを選択
あいさつを表示するラジオボタンを選択

オブジェクトのプロパティ

名前	種類	Caption	GourpName	Tag	Value（初期値）
rdo_showCurrent	ラジオボタン	現在時刻を表示する	Group01	Current	True
rdo_showUser	ラジオボタン	ユーザ名を表示する	Group01	User	False
rdo_showGreeting	ラジオボタン	あいさつを表示する	Group01	Greeting	False
btn_execute	コマンドボタン	実行	--	--	--

関数概要

名前	所属モジュール/クラス	種類	機能
btn_execute_Click	F_Main	Subプロシージャ	btn_executeのClickメソッドラジオボタンの種類に応じた処理を実行する
btn_execute_Click_Current	clsPolymo	Functionプロシージャ	現在時刻を表示する
btn_execute_Click_User	clsPolymo	Functionプロシージャ	ユーザ名を表示する
btn_execute_Click_Greeting	clsPolymo	Functionプロシージャ	あいさつを表示する

コード

[btn_execute_Click]

 1'******************************************************************************************
 2'*関数名    ：btn_execute_Click
 3'*機能      ：
 4'*引数(1)   ：
 5'******************************************************************************************
 6Private Sub btn_execute_Click()
 7    
 8    '定数
 9    Const FUNC_NAME As String = "btn_execute_Click"
10    
11    '変数
12    Dim suffix As String
13    Dim objPolymo As clsPolymo
14    
15    On Error GoTo ErrorHandler
16    
17    Set objPolymo = New clsPolymo
18    
19    '選択された処理を取得
20    '再帰的なファイル検索の有無
21    suffix = _
22           WorksheetFunction.Rept(Me.rdo_showCurrent.Tag, Abs(CLng(CBool(Me.rdo_showCurrent.Value)))) & _
23           WorksheetFunction.Rept(Me.rdo_showUser.Tag, Abs(CLng(CBool(Me.rdo_showUser.Value)))) & _
24           WorksheetFunction.Rept(Me.rdo_showGreeting.Tag, Abs(CLng(CBool(Me.rdo_showGreeting.Value))))
25    If suffix = "" Then MsgBox "ラジオボタンの選択が不正です", vbCritical, Tool_Name: GoTo ExitHandler
26    
27    '処理関数の呼出
28    If Not CallByName(objPolymo, FUNC_NAME & "_" & suffix, VbMethod) Then GoTo ExitHandler
29    
30
31ExitHandler:
32    
33    Set objPolymo = Nothing
34    
35    Exit Sub
36    
37ErrorHandler:
38
39    MsgBox "エラーが発生したため、マクロを終了します。" & _
40           vbLf & _
41           "関数名：" & FUNC_NAME & _
42           vbLf & _
43           "エラー番号：" & Err.Number & vbNewLine & _
44           Err.Description, vbCritical, Tool_Name
45        
46    GoTo ExitHandler
47        
48End Sub

WorksheetFunction.Rept関数は
①引数の文字列を②引数の数だけ繰り返した文字列を返す。

1'abcabcabc
2WorksheetFunction.Rept("abc",3)

Abs(CLng(CBool(Me.rdo_showCurrent.Value)))は、
ラジオボタンが選択された状態であれば、1を、
非選択の状態であれば、0を返す。

よって、
suffix変数には、選択されたラジオボタンのみのTagプロパティの文字列が
代入される。

CallByName関数によって、
clsPolymoクラスに用意されている、
btn_execute_Click＋〇〇（Tagの文字）の関数が呼び出される。

[btn_execute_Click_Current]

 1'******************************************************************************************
 2'*関数名    ：btn_execute_Click_Current
 3'*機能      ：現在時刻を表示する
 4'*引数(1)   ：
 5'*戻り値    ：True > 正常終了、False > 異常終了
 6'******************************************************************************************
 7Public Function btn_execute_Click_Current() As Boolean
 8    
 9    '定数
10    Const FUNC_NAME As String = "btn_execute_Click_Current"
11    
12    '変数
13    
14    On Error GoTo ErrorHandler
15
16    btn_execute_Click_Current = False
17    
18    '現在時刻を表示する
19    MsgBox "現在時刻：" & Now, , Tool_Name
20
21    btn_execute_Click_Current = True
22    
23ExitHandler:
24
25    Exit Function
26    
27ErrorHandler:
28
29    MsgBox "エラーが発生したため、マクロを終了します。" & _
30           vbLf & _
31           "関数名：" & FUNC_NAME & _
32           vbLf & _
33           "エラー番号：" & Err.Number & vbNewLine & _
34           Err.Description, vbCritical, Tool_Name
35        
36    GoTo ExitHandler
37        
38End Function

[btn_execute_Click_User]

 1'******************************************************************************************
 2'*関数名    ：btn_execute_Click_User
 3'*機能      ：ユーザ名を表示する
 4'*引数(1)   ：
 5'*戻り値    ：True > 正常終了、False > 異常終了
 6'******************************************************************************************
 7Public Function btn_execute_Click_User() As Boolean
 8    
 9    '定数
10    Const FUNC_NAME As String = "btn_execute_Click_User"
11    
12    '変数
13    
14    On Error GoTo ErrorHandler
15
16    btn_execute_Click_User = False
17    
18    With CreateObject("WScript.Network")
19        'ユーザ名を表示する
20        MsgBox "ユーザ名：" & .UserName, , Tool_Name
21    End With
22
23    btn_execute_Click_User = True
24    
25ExitHandler:
26
27    Exit Function
28    
29ErrorHandler:
30
31    MsgBox "エラーが発生したため、マクロを終了します。" & _
32           vbLf & _
33           "関数名：" & FUNC_NAME & _
34           vbLf & _
35           "エラー番号：" & Err.Number & vbNewLine & _
36           Err.Description, vbCritical, Tool_Name
37        
38    GoTo ExitHandler
39        
40End Function
41

[btn_execute_Click_Greeting]

 1'******************************************************************************************
 2'*関数名    ：btn_execute_Click_Greeting
 3'*機能      ：あいさつを表示する
 4'*引数(1)   ：
 5'*戻り値    ：True > 正常終了、False > 異常終了
 6'******************************************************************************************
 7Public Function btn_execute_Click_Greeting() As Boolean
 8    
 9    '定数
10    Const FUNC_NAME As String = "btn_execute_Click_Greeting"
11    
12    '変数
13    
14    On Error GoTo ErrorHandler
15
16    btn_execute_Click_Greeting = False
17    
18    MsgBox "こんにちは。", , Tool_Name
19    
20    btn_execute_Click_Greeting = True
21    
22ExitHandler:
23
24    Exit Function
25    
26ErrorHandler:
27
28    MsgBox "エラーが発生したため、マクロを終了します。" & _
29           vbLf & _
30           "関数名：" & FUNC_NAME & _
31           vbLf & _
32           "エラー番号：" & Err.Number & vbNewLine & _
33           Err.Description, vbCritical, Tool_Name
34        
35    GoTo ExitHandler
36        
37End Function

ポリモーフィズムによって、
clsPolymoから呼び出される関数が
suffixの値に従って決定されるため、
IFステートメントの使用無しで処理分岐を実行できる。

この仕組みを使用したツール

↓↓こちらの記事で紹介しました。 ↓↓
[Excel VBA]選択フォルダ配下のエクセルブックの全シートでA1にカーソル移動させるツールを作成した

comments powered by Disqus

Translations:

"English" |