EXCEL VBA: WITH POLYMORPHISM, BRANCHING A PROCESS WITHOUT USING IF STATEMENT
Overview
Help me improve my English!
As you probably see, I'm not a native English speaker.If you find an English expression that feel incorrect or awkward, please let me know.
Message box of Disqus is under the article.
Or my E-Mail is here.
ABOUT THIS ARTICLE
Hi, I'm Dede.
Here I introduce a sample of coding based on a thinking of Polymorphism in VBA.
In detail, in the sample I branched a process without using If statement, by using polymorphism implemented by CallByName and Tag Property of Radio Buttons in a Form.
You can download Excel file created for explanation and view its source code from here!
CREATION ENVIRONMENT
Windows10
MSOffice 2016
PREMISE
There is a following screen and you perform a process that depends on the type of radio button by selecting one of them and pressing 'Run'.
| Name | Image |
|---|---|
| Form |  |
| Select a radio button showing current time |  |
| Select a radio button showing user name |  |
| Select a radio button showing greeting |  |
FORM COMPONENTS
| Name | Type | Caption | GourpName | Tag | Initial Value |
|---|---|---|---|---|---|
| rdo_showCurrent | Radio Button | show current tiem | Group01 | Current | True |
| rdo_showUser | Radio Button | show user name | Group01 | User | False |
| rdo_showGreeting | Radio Button | show greeting | Group01 | Greeting | False |
| btn_execute | command button | Run process | -- | -- | -- |
OVERVIEW OF FUNCTIONS
| Name | Module/Class | Type | Functionality |
|---|---|---|---|
| btn_execute_Click | F_Main | Sub Procedure | Click event function of btn_execute perform a process that depends on the type of radio button |
| btn_execute_Click_Current | clsPolymo | Function Procedure | show current time |
| btn_execute_Click_User | clsPolymo | Function Procedure | show user name |
| btn_execute_Click_Greeting | clsPolymo | Function Procedure | show greeting |
CODE
[btn_execute_Click]
1'******************************************************************************************
2'*Function :
3'*Arg(1) :
4'******************************************************************************************
5Private Sub btn_execute_Click()
6
7 'Consts
8 Const FUNC_NAME As String = "btn_execute_Click"
9
10 'Vars
11 Dim suffix As String
12 Dim objPolymo As clsPolymo
13
14 On Error GoTo ErrorHandler
15
16 'instantiate a class of processings
17 Set objPolymo = New clsPolymo
18
19 'get selected processing flag string
20 suffix = _
21 WorksheetFunction.Rept(Me.rdo_showCurrent.Tag, Abs(CLng(CBool(Me.rdo_showCurrent.Value)))) & _
22 WorksheetFunction.Rept(Me.rdo_showUser.Tag, Abs(CLng(CBool(Me.rdo_showUser.Value)))) & _
23 WorksheetFunction.Rept(Me.rdo_showGreeting.Tag, Abs(CLng(CBool(Me.rdo_showGreeting.Value))))
24 If suffix = "" Then MsgBox "Radio button selection is invalid.", vbCritical, Tool_Name: GoTo ExitHandler
25
26 'call corresponding processing function
27 If Not CallByName(objPolymo, FUNC_NAME & "_" & suffix, VbMethod) Then GoTo ExitHandler
28
29
30ExitHandler:
31
32 Set objPolymo = Nothing
33
34 Exit Sub
35
36ErrorHandler:
37
38 MsgBox "An error has occurred and the macro will be terminated." & _
39 vbLf & _
40 "Func Name:" & FUNC_NAME & _
41 vbLf & _
42 "Error No." & Err.Number & vbNewLine & _
43 Err.Description, vbCritical, Tool_Name
44
45 GoTo ExitHandler
46
47End Sub
48
49
WorksheetFunction.Rept function returns a string which is constructed by repeating a first parameter string for the number of times given as a second parameter.
1'abcabcabc
2WorksheetFunction.Rept("abc",3)
Abs(CLng(CBool(Me.rdo_showCurrent.Value))) presents 1 when target radio buttons selected, and 2 when not selected.
So, suffix is assigned to a string of Tag property belonging to selected radio button.
After that, a function in clsPolymo named btn_execute_Click + XX is called by using build-in CallByName function.
XX indicates a tag property string.
[btn_execute_Click_Current]
1'******************************************************************************************
2'*Function :show current time
3'*Arg(1) :
4'*Return :True > normal termination; False > abnormal termination
5'******************************************************************************************
6Public Function btn_execute_Click_Current() As Boolean
7
8 'Consts
9 Const FUNC_NAME As String = "btn_execute_Click_Current"
10
11 'Vars
12
13 On Error GoTo ErrorHandler
14
15 btn_execute_Click_Current = False
16
17 'show current time
18 MsgBox "Current time: " & Now, , Tool_Name
19
20 btn_execute_Click_Current = True
21
22ExitHandler:
23
24 Exit Function
25
26ErrorHandler:
27
28 MsgBox "An error has occurred and the macro will be terminated." & _
29 vbLf & _
30 "Func Name:" & FUNC_NAME & _
31 vbLf & _
32 "Error No." & Err.Number & vbNewLine & _
33 Err.Description, vbCritical, Tool_Name
34
35 GoTo ExitHandler
36
37End Function
[btn_execute_Click_User]
1'******************************************************************************************
2'*Function :show PC user name
3'*Arg(1) :
4'*Return :True > normal termination; False > abnormal termination
5'******************************************************************************************
6Public Function btn_execute_Click_User() As Boolean
7
8 'Consts
9 Const FUNC_NAME As String = "btn_execute_Click_User"
10
11 'Vars
12
13 On Error GoTo ErrorHandler
14
15 btn_execute_Click_User = False
16
17 With CreateObject("WScript.Network")
18 'show PC user name
19 MsgBox "Use name: " & .UserName, , Tool_Name
20 End With
21
22 btn_execute_Click_User = True
23
24ExitHandler:
25
26 Exit Function
27
28ErrorHandler:
29
30 MsgBox "An error has occurred and the macro will be terminated." & _
31 vbLf & _
32 "Func Name:" & FUNC_NAME & _
33 vbLf & _
34 "Error No." & Err.Number & vbNewLine & _
35 Err.Description, vbCritical, Tool_Name
36
37 GoTo ExitHandler
38
39End Function
40
[btn_execute_Click_Greeting]
1'******************************************************************************************
2'*Function :show greeting
3'*Arg(1) :
4'*Return :True > normal termination; False > abnormal termination
5'******************************************************************************************
6Public Function btn_execute_Click_Greeting() As Boolean
7
8 'Consts
9 Const FUNC_NAME As String = "btn_execute_Click_Greeting"
10
11 'Vars
12
13 On Error GoTo ErrorHandler
14
15 btn_execute_Click_Greeting = False
16
17 MsgBox "Hello.", , Tool_Name
18
19 btn_execute_Click_Greeting = True
20
21ExitHandler:
22
23 Exit Function
24
25ErrorHandler:
26
27 MsgBox "An error has occurred and the macro will be terminated." & _
28 vbLf & _
29 "Func Name:" & FUNC_NAME & _
30 vbLf & _
31 "Error No." & Err.Number & vbNewLine & _
32 Err.Description, vbCritical, Tool_Name
33
34 GoTo ExitHandler
35
36End Function
With polymorphism, which function is to be called is determined by suffix value, and you can branch a process without using If statement.
A TOOL USING THE MECHANISM
Introduced by following article:
EXCEL VBA: I CREATED A TOOL THAT ALL SELECTED EXCEL BOOK HAVE THEIR CURSOR MOVED TO A1.
See Also
- EXCEL VBA: I CREATED A TOOL THAT ALL SELECTED EXCEL BOOK HAVE THEIR CURSOR MOVED TO A1.
- EXCEL VBA: I CREATED A QUOTATION CREATION TOOL.
- ACCESS VBA: I CREATED A TOOL EXPORTING TABLE DEFINITIONS DISPLAYED AT DESIGN VIEW IN A TABULAR FORMAT.
- ACCESS VBA: I CREATED A FUNCTION EXPORTING TABLE DEFINITIONS DISPLAYED AT DESIGN VIEW IN A TABULAR FORMAT.
- [EXCEL] I CREATED A MAIL CREATION TOOL WHICH IS NON-MACRO.