I recently developed a tool which automaticaly generates VBA code in order to smoothly create class templates. I wanted to share this tool with the community, hopefully this is the right place.
The idea is to put the definition of your class on "paper", via an excel spreadsheet:
- Create a new sheet or chose an empty spot on a random sheet
- Type the name of your class in one cell
- All the cells below will contain the name of a member of your class
- The cells adjacent (to the right) of the step 3 cells will provide the type (if the member is a method, leave blank)
- The cells adjacent to the step 4 cells will provide read and write attributes (if the member is a function or a method, leave blank)
- The cells adjacent to the step 5 cells will provide a description of the member (optional)
- The cells adjacent to the step 6 cells go by pairs and will provide the parameters of the member (for functions and methods only, and if relevant). There can be as many pairs as required: column N is the variable name, column N+1 is the variable type
- Select the range containing your data (except the Class name, which will be located just above your selection)
- Run subroutine Main (code provided below)
- The generated code is exported in the Inmediate Window
See below the example of an Excel sheet showing the class definition. The range selection required before running the code is shown in red.
The class template code generated from the above example looks as follows:
'CLIENTFILE
'
'Properties:
' - Id R Long A cumulative Id number (attributed during initialization)
' - FirstName RW String First name
' - LastName RW String Last Name
' - DateOfBirth RW Date Date of Birth
' - Sales RW String Coll A collection of strings which represent sales ID numbers
' - Proposals RW clsProposal coll A collection of clsProposal objects which represent the proposals sent in the past
'Functions:
' - NewProposal clsProposal Returns a Proposal for given sales parameters
'Methods:
' - SendBestWishes Sends a wishes card (why not?)
' - MakePremium Upgrades the client to Premium
Option Explicit
Private lId as Long
Private sFirstName as String
Private sLastName as String
Private dDateOfBirth as Date
Private cSales as New Collection
Private oProposals as New coll
'##### INITIALIZE #####
Private Sub class_Initialize()
Debug.Print "clsClientFile initilized"
End Sub
'##### PROPERTIES #####
'# ID
'A cumulative Id number (attributed during initialization)
Public Property Get Id() as Long
Id = lId
End Property
'# FIRSTNAME
'First name
Public Property Get FirstName() as String
FirstName = sFirstName
End Property
Public Property Let FirstName(Var as String)
sFirstName = Var
End Property
'# LASTNAME
'Last Name
Public Property Get LastName() as String
LastName = sLastName
End Property
Public Property Let LastName(Var as String)
sLastName = Var
End Property
'# DATEOFBIRTH
'Date of Birth
Public Property Get DateOfBirth() as Date
DateOfBirth = dDateOfBirth
End Property
Public Property Let DateOfBirth(Var as Date)
dDateOfBirth = Var
End Property
'# SALES
'A collection of strings which represent sales ID numbers
Public Property Get Sales() as Collection
Set Sales = cSales
End Property
Public Property Set Sales(Var as Collection)
Set cSales = Var
End Property
'# PROPOSALS
'A collection of clsProposal objects which represent the proposals sent in the past
Public Property Get Proposals() as coll
Set Proposals = oProposals
End Property
Public Property Set Proposals(Var as coll)
Set oProposals = Var
End Property
'##### FUNCTIONS #####
'# NEWPROPOSAL
'Returns a Proposal for given sales parameters
Public Function NewProposal(ByVal sTitle as String, ByVal sExpDate as Date) as clsProposal
End Function
'##### METHODS #####
'# SENDBESTWISHES
'Sends a wishes card (why not?)
Public Sub SendBestWishes(ByVal sAddress as String)
End Sub
'# MAKEPREMIUM
'Upgrades the client to Premium
Public Sub MakePremium
End Sub
The source code is provided below:
STANDARD MODULE
Option Explicit
'##### GEN CLASS CODE #####
'Generates code in the Immediate Window
'Select in a Spreadsheet the list of Properties, Functions, and Methods to be incorporated within the Class.
'The row just above the selection provides the Class Name in the cell of column 1 of the selection, and an optionnal Description in column 2.
'Each Row of the selection must represent a Member, and the Columns must be structured as follows: (x = must be provided, o = must not be provided, ? = can be provided)
'Column Property Function Method Comment
' - 1: Member Name x x x
' - 2: Member Variable Type x x o Variable Type of the Variable returned by Property or Function.
' - 3: Member Rights x o o Defines if the Member is Read Only, Write Only, or Both: type 'R', 'W', or 'RW'.
' - 4: Member Description ? ? ? Will be inserted in the Class Summary Header, as well as in the Member Mini Header. Usually empty if the Member is a Property.
' - 5-6+: Member Input Variables o ? ? Pairs of value : column N is VarName, column N+1 is VarType. If more than one Input Variable is required, reapeat with columns 7-8, etc.
'Non-Object Variable Types (Object variables require a Let and New statement)
Private Const cstNonObjectVariables = "Variant, Integer, Long, Single, Double, Currency, Date, String, Boolean, Byte, LongLong, LongPtr"
'Variable Type and their corresponding Prefix (for Hungarian style nomenclature; update cstVariablesPrefix to = "p, p, p, p, p, p, p, p, p, p, p, p, p, " to ignore)
Private Const cstVariableTypes = "Variant, Integer, Long, Single, Double, Currency, Date, String, Boolean, Byte, LongLong, LongPtr, Collection, Object"
Private Const cstVariablesPrefix = "v, i, l, sgl, dbl, ccy, d, s, b, by, h, h, c, o"
'Maximum lengths per column (for Class Summary Header)
Private Const cstMaxLenName = 25
Private Const cstMaxLenRW = 4
Private Const cstMaxLenVarType = 25
Sub main()
'***** PREPARE DATA *****
'# Read and Verify Selection
Dim rngRawInput As Range
Set rngRawInput = Selection
If Selection.Columns.Count > 4 And (Selection.Columns.Count - 4) Mod 2 <> 0 _
Then MsgBox "Selection is wrong, please try again", vbCritical + vbOKOnly, "Excel clsGen": End
If rngRawInput.Columns.Count < 6 Then Set rngRawInput = rngRawInput.Resize(, 6)
'# Save Selection Content
Dim sClassName As String
Dim sClassDescription As String
sClassName = rngRawInput.Offset(-1, 0).Cells(1, 1).Value2
sClassDescription = rngRawInput.Offset(-1, 0).Cells(1, 2).Value2
Dim arrName() As Variant
Dim arrVarType() As Variant
Dim arrRights() As Variant
Dim arrDescription() As Variant
Dim arrInputVars() As Variant
arrName = rngRawInput.Columns(1).Value2
arrVarType = rngRawInput.Columns(2).Value2
arrRights = rngRawInput.Columns(3).Value2
arrDescription = rngRawInput.Columns(4).Value2
arrInputVars = ActiveSheet.Range(Cells(rngRawInput.Row, rngRawInput.Column + 4), _
Cells(rngRawInput.Row + rngRawInput.Rows.Count - 1, rngRawInput.Column + rngRawInput.Columns.Count - 1)).Value2
'# Identify Selection Content Member Types and Populate relevant Collections
Dim cProperties As New Collection
Dim cFunctions As New Collection
Dim cMethods As New Collection
Dim myMember As clsGenClsMember
Dim i As Integer
Dim j As Integer
For i = LBound(arrName) To UBound(arrName)
Set myMember = New clsGenClsMember
With myMember
.Name = arrName(i, 1)
.VarType = Replace(Split(arrVarType(i, 1) & " ", " ")(VBAexcelBasics.FunctionsStrings.strCount(CStr(arrVarType(i, 1)), " ")), "Coll", "Collection", , , vbTextCompare) '"oVariable Coll" -> "Collection" (of oVariable type)
.VarTypeFull = arrVarType(i, 1)
.Rights = arrRights(i, 1)
.Description = arrDescription(i, 1)
.InputVars = Application.WorksheetFunction.Index(arrInputVars, i, 0)
'Input check
If StrComp(.Name, "Val", vbTextCompare) = 0 Then _
MsgBox "Member name cannot be 'val', please try again with another name.", vbCritical + vbOKOnly, "Excel clsGen": End
If Len(.Name) > cstMaxLenName Or Len(.Rights) > cstMaxLenRW Or Len(.VarTypeFull) > cstMaxLenVarType Then _
MsgBox "Member Name, RW statement, and/or Description are too long, please try again with something shorter.", vbCritical + vbOKOnly, "Excel clsGen": End
'Member is a Property
If .Name <> "" And .VarType <> "" And .Rights <> "" And .InputVars(1) = "" Then
cProperties.Add myMember
'Member is a Function
ElseIf .Name <> "" And .VarType <> "" And .Rights = "" And .InputVars(1) <> "" Then
cFunctions.Add myMember
'Member is a Method
ElseIf .Name <> "" And .VarType = "" And .Rights = "" Then
cMethods.Add myMember
'Unable to identify Member kind
Else
MsgBox "Unable to Identify Content of row " & i & " (" & .Name & "). Please verify and try again.", _
vbCritical + vbOKOnly, "Excel clsGen": End
End If
End With
Next
'***** PRINT DATA *****
Dim sPrint As String
Dim sOutput As String
Dim arrNonObjectVariables() As String
arrNonObjectVariables = Split(cstNonObjectVariables, ", ")
'# Print Summary Header
sPrint = "'@ClassName" & vbNewLine _
& "'@ClassDescription" & vbNewLine _
sPrint = Replace(sPrint, "@ClassName", StrConv(Mid(sClassName, 4, Len(sClassName) - 3), vbUpperCase))
sPrint = Replace(sPrint, "@ClassDescription" & vbNewLine, IIf(sClassDescription = "", "", sClassDescription & vbNewLine))
sOutput = sOutput & sPrint
'Properties
sOutput = sOutput & vbNewLine _
& "'Properties:" & vbNewLine
For Each myMember In cProperties
With myMember
sOutput = sOutput & "' - " & .Name & Space(cstMaxLenName - Len(.Name)) _
& .Rights & Space(cstMaxLenRW - Len(.Rights)) _
& .VarTypeFull & Space(cstMaxLenVarType - Len(.VarTypeFull)) _
& .Description & vbNewLine
End With
Next
'Functions
sOutput = sOutput & vbNewLine _
& "'Functions:" & vbNewLine
For Each myMember In cFunctions
With myMember
sOutput = sOutput & "' - " & .Name & Space(cstMaxLenName + cstMaxLenRW - Len(.Name)) _
& .VarTypeFull & Space(cstMaxLenVarType - Len(.VarTypeFull)) _
& .Description & vbNewLine
End With
Next
'Methods
sOutput = sOutput & vbNewLine _
& "'Methods:" & vbNewLine
For Each myMember In cMethods
With myMember
sOutput = sOutput & "' - " & .Name & Space(cstMaxLenName - Len(.Name)) _
& .Description & vbNewLine
End With
Next
sOutput = sOutput & vbNewLine _
& "Option Explicit" & vbNewLine _
& vbNewLine _
& vbNewLine
'# Print Private Variables
For Each myMember In cProperties
With myMember
sPrint = "Private @p@VarName as @New @VarType" & vbNewLine
sPrint = Replace(sPrint, "@VarName", .Name)
sPrint = Replace(sPrint, "@New ", IIf(UBound(Filter(arrNonObjectVariables, .VarType, , vbTextCompare)) > -1, "", "New "))
sPrint = Replace(sPrint, "@p", VarPrefix(.VarType))
sPrint = Replace(sPrint, "@VarType", .VarType)
sOutput = sOutput & sPrint
End With
Next
'# Print Initialize
sPrint = vbNewLine _
& vbNewLine _
& vbNewLine _
& "'##### INITIALIZE #####" & vbNewLine _
& vbNewLine _
& "Private Sub class_Initialize()" & vbNewLine _
& " Debug.Print ""@ClassName initilized"" " & vbNewLine _
& "End Sub" & vbNewLine
sPrint = Replace(sPrint, "@ClassName", sClassName)
sOutput = sOutput & sPrint
'# Print Properties
sPrint = vbNewLine _
& vbNewLine _
& vbNewLine _
& "'##### PROPERTIES #####" & vbNewLine
sOutput = sOutput & sPrint
For Each myMember In cProperties
With myMember
'Prepare Print
sPrint = vbNewLine _
& vbNewLine _
& "'# @VARNAME" & vbNewLine _
& vbNewLine
If InStr(.Rights, "R") <> 0 Then sPrint = sPrint & "'@Description" & vbNewLine _
& "Public Property Get @VarName() as @VarType" & vbNewLine _
& " @Set @VarName = @p@VarName" & vbNewLine _
& "End Property" & vbNewLine
If InStr(.Rights, "W") <> 0 Then sPrint = sPrint & "Public Property @LetSet @VarName(Var as @VarType)" & vbNewLine _
& " @Set @p@VarName = Var" & vbNewLine _
& "End Property" & vbNewLine
'Replace PlaceHolders
sPrint = Replace(sPrint, "@VARNAME", UCase(.Name))
sPrint = Replace(sPrint, "@Description", .Description)
sPrint = Replace(sPrint, "@VarName", .Name)
sPrint = Replace(sPrint, "@VarType", .VarType)
sPrint = Replace(sPrint, "@Set ", IIf(UBound(Filter(arrNonObjectVariables, .VarType, , vbTextCompare)) > -1, "", "Set "))
sPrint = Replace(sPrint, "@p", VarPrefix(.VarType))
sPrint = Replace(sPrint, "@LetSet", IIf(UBound(Filter(arrNonObjectVariables, .VarType, , vbTextCompare)) > -1, "Let", "Set"))
sOutput = sOutput & sPrint
End With
Next
'# Print Functions
sPrint = vbNewLine _
& vbNewLine _
& vbNewLine _
& "'##### FUNCTIONS #####" & vbNewLine
sOutput = sOutput & sPrint
Dim sArgumentPairs
For Each myMember In cFunctions
With myMember
'Prepare Print
sPrint = vbNewLine _
& vbNewLine _
& "'# @NAME" & vbNewLine _
& vbNewLine _
& "'@Description" & vbNewLine _
& "Public Function @Name(@ArgumentPairs) as @VarType" & vbNewLine _
& " " & vbNewLine _
& "End Function" & vbNewLine
'Replace PlaceHolders
sPrint = Replace(sPrint, "@NAME", UCase(.Name))
sPrint = Replace(sPrint, "@Description", .Description)
sPrint = Replace(sPrint, "@Name", .Name)
sPrint = Replace(sPrint, "@VarType", .VarType)
'Check if Arguments List provided
If .InputVars(1) = "" Then
sPrint = Replace(sPrint, "(@ArgumentPairs)", "")
Else
sArgumentPairs = ""
For i = LBound(.InputVars) To UBound(.InputVars) Step 2
If .InputVars(i) = "" Then Exit For
sArgumentPairs = sArgumentPairs & "ByVal " & .InputVars(i) & " as " & .InputVars(i + 1) & ", "
Next
sArgumentPairs = Left(sArgumentPairs, Len(sArgumentPairs) - Len(", "))
sPrint = Replace(sPrint, "@ArgumentPairs", sArgumentPairs)
End If
sOutput = sOutput & sPrint
End With
Next
'# Print Methods
sPrint = vbNewLine _
& vbNewLine _
& vbNewLine _
& "'##### METHODS #####" & vbNewLine
sOutput = sOutput & sPrint
For Each myMember In cMethods
With myMember
'Prepare Print
sPrint = vbNewLine _
& vbNewLine _
& "'# @NAME" & vbNewLine _
& vbNewLine _
& "'@Description" & vbNewLine _
& "Public Sub @Name(@ArgumentPairs)" & vbNewLine _
& " " & vbNewLine _
& "End Sub" & vbNewLine
'Replace PlaceHolders
sPrint = Replace(sPrint, "@NAME", UCase(.Name))
sPrint = Replace(sPrint, "@Description", .Description)
sPrint = Replace(sPrint, "@Name", .Name)
'Check if Arguments List provided
If .InputVars(1) = "" Then
sPrint = Replace(sPrint, "(@ArgumentPairs)", "")
Else
sArgumentPairs = ""
For i = LBound(.InputVars) To UBound(.InputVars) Step 2
If .InputVars(i) = "" Then Exit For
sArgumentPairs = sArgumentPairs & "ByVal " & .InputVars(i) & " as " & .InputVars(i + 1) & ", "
Next
sArgumentPairs = Left(sArgumentPairs, Len(sArgumentPairs) - Len(", "))
sPrint = Replace(sPrint, "@ArgumentPairs", sArgumentPairs)
End If
sOutput = sOutput & sPrint
End With
Next
'# Export Print Code to Immediate Window
Debug.Print sOutput
End Sub
'# Returns the generic prefix of a given Variable Type, according to the Naming Convention
Private Function VarPrefix(sVarType As String) As String
Dim arrVariableTypes() As String
Dim arrVariablesPrefixes() As String
arrVariableTypes = Split(cstVariableTypes, ", ")
arrVariablesPrefixes = Split(cstVariablesPrefix, ", ")
Dim i As Integer
For i = LBound(arrVariableTypes) To UBound(arrVariableTypes)
If StrComp(sVarType, arrVariableTypes(i), vbTextCompare) = 0 Then VarPrefix = arrVariablesPrefixes(i): Exit Function
Next i
'Else it is an Object
VarPrefix = "o"
End Function
CLASS MODULE, Name = clsGenClsMember
Option Explicit
Private sName As String
Private sVarType As String
Private sVarTypeFull As String
Private sRights As String
Private sDescription As String
Private arrInputVars As Variant
Public Property Get Name() As String
Name = sName
End Property
Public Property Let Name(Var As String)
sName = Var
End Property
Public Property Get VarType() As String
VarType = sVarType
End Property
Public Property Let VarType(Var As String)
sVarType = Var
End Property
Public Property Get VarTypeFull() As String
VarTypeFull = sVarTypeFull
End Property
Public Property Let VarTypeFull(Var As String)
sVarTypeFull = Var
End Property
Public Property Get Rights() As String
Rights = sRights
End Property
Public Property Let Rights(Var As String)
sRights = Var
End Property
Public Property Get Description() As String
Description = sDescription
End Property
Public Property Let Description(Var As String)
sDescription = Var
End Property
Public Property Get InputVars() As Variant
InputVars = arrInputVars
End Property
Public Property Let InputVars(Var As Variant)
arrInputVars = Var
End Property
-
3\$\begingroup\$ Hey, cool idea and welcome to CR, hope you get some good reviews! I have a feeling you might soon be inundated with a load of suggestions about new features you could implement, improvements to be made etc. So a little bit of advice off the bat; be wary of feature creep (that is, making your method do more and more stuff). There's practically no limit to the possibilities available with automatic code creation, right now you have a great working example, but if you are to expand it any further I think you'll have to refactor it into separate methods/ classes. Just something to be aware of. \$\endgroup\$Greedo– Greedo2019年02月05日 17:10:33 +00:00Commented Feb 5, 2019 at 17:10
-
6\$\begingroup\$ You need to read Joel Spolsky's (author of the VBA language specifications and co-founder of Stack Exchange) excellent Making Wrong Code Look Wrong article about Hungarian Notation and how Systems Hungarian was nothing but a huge misunderstanding that grew into a huge mess in the 90's. Hungarian Notation was intended to be Apps Hungarian, and that naming scheme has nothing whatsoever to do with "s-for-string, o-for-object", and the like. \$\endgroup\$Mathieu Guindon– Mathieu Guindon2019年02月05日 17:19:35 +00:00Commented Feb 5, 2019 at 17:19
-
\$\begingroup\$ @Greedo thanks, I am not intending to "upgrade" the code, this is more a "framework" where people can take it from and adjust it to their own needs. \$\endgroup\$Ama– Ama2019年02月06日 12:44:39 +00:00Commented Feb 6, 2019 at 12:44
-
3\$\begingroup\$ I have rolled back your last edits. Please do not update the code in your question to incorporate feedback from answers, doing so goes against the Question + Answer style of Code Review. This is not a forum where you should keep the most updated version in your question. Please see what you may and may not do after receiving answers . \$\endgroup\$Heslacher– Heslacher2019年02月06日 14:22:03 +00:00Commented Feb 6, 2019 at 14:22
-
3\$\begingroup\$ Please stop updating your post with feedback from answers, it invalidates them and will be consistently rolled back. See @Heslacher's comment. \$\endgroup\$Mathieu Guindon– Mathieu Guindon2019年02月06日 14:37:35 +00:00Commented Feb 6, 2019 at 14:37
3 Answers 3
Before diving into the code itself, I'm going to go over a couple "structural things".
First, I'm not entirely sure what the utility of a tool like this actually is. When I'm writing code in the Visual Basic Editor, I get all of this great help like IntelliSense, syntax highlighting, an Object Browser, etc., etc. (and this is before using custom add-ins like Rubberduck 1).
Writing code in a spreadsheet strikes me as, well, a bit strange. It seems like this wants a better interface - something like a wizard (or at very least a UserForm
). Currently it has a major drawback in that it requires me to add a worksheet to an existing workbook to run it, which makes it harder to, say, package as an add-in.
The second glaring structural issue is that the code is output to the Immediate Window, which only has a 200 line buffer. The sample output from the question is already getting very close to running past that maximum buffer size (and this is exacerbated by some things I'll mention below). On top of that, there is absolutely zero validation to make sure that the output isn't going to end up with the top half of the template chopped off in the Immediate Window. This could be easily resolved by sending output to a text file or (better) using the VBE's object model to generate the class directly. I consider this a fairly substantial bug.
Coding Style
1.) Hungarian Notation2 - @MathieuGuindon provided an excellent link in his comment. I highly recommend reading it, and then using the current Microsoft Visual Basic Naming Conventions - they ditched this ancient style for a good reason.
That said, even if you completely disagree with this, the use of h
as a prefix for LongPtr
and LongLong
is completely misleading to anyone familiar with the Windows APIs. In the Windows API, an h
is a handle and lp
is used for a long pointer. There's a difference between the two that simply can't be captured by a single variable type (and on a 32 bit install a Long
could also be either a handle or a pointer). Consistently using h
for any LongPtr
is dangerously misleading. See this answer over on SO.
2.) Indentation - Overall not bad, but whatever convention you decide to use for indenting, it should be made consistent. For example, With
is indented like this in some places...
For i = LBound(arrName) To UBound(arrName) Set myMember = New clsGenClsMember With myMember
... and this in others:
For Each myMember In cProperties With myMember
I'd personally consider the top style "correct". Say what you will about other structures, but IMO a loop should always add another indentation level.
3.) Comments - Comments should explain the why of the code and not the how of the code. One perfect example of this is the comment '# Export Print Code to Immediate Window
, followed immediately by Debug.Print sOutput
. I'm going to go out on a limb here and say that if somebody is generating a class template from an Excel spreadsheet and doesn't know what Debug.Print
does, they probably shouldn't be generating a class template from an Excel spreadsheet.
Code should be self documenting to the extend possible - this means picking names that make it obvious what things represent or do. Banner comments like '***** PREPARE DATA *****
inside of procedures are a huge red flag for me also. If the procedure needs a sign-post as to what's going on in a function, then that function is doing too much.
For example, in Sub main
, I would at very least take each banner header like that and make it into a function of the same name, i.e. Function PrepareData()
. The generated code probably doesn't need comments at all. First, because the comment at the top is basically just the data used to generate the class (and that's still on my spreadsheet, right?) - and if the object model is decent and the naming is good, I shouldn't need that at all.
Oh yeah - and that thing from earlier about the Immediate Window only having a 200 line buffer? This is where that bug is exacerbated. Every single needless comment reduces the amount of useful output that can be generated.
4.) The "God Procedure" - I alluded to this above, but the main
procedure does way to much. The procedure body is 321 lines long, and requires paging down 7 times with my VBE settings to get from the top of the procedure to the bottom. If I strip out all of the vertical white-space and comments, it's still 208 lines (yep, 113 lines are pure scroll-bar). There's no conceivable way that I could tell with a casual inspection what it does (or what the variables are for that matter - they're mostly declared a couple hundred lines up). This should be split into discrete parts that each handle a very specific concern.
5.) Constants - First, these have types too - they should be explicitly declared. This...
Private Const cstMaxLenName = 25 Private Const cstMaxLenRW = 4 Private Const cstMaxLenVarType = 25
...should look more like this:
Private Const MaximumNameLength As Long = 25
Private Const MaximumAccessFlagLength As Long = 4
Private Const MaximumVariableTypeLength As Long = MaximumNameLength
In addition, cstVariableTypes
and cstVariablesPrefix
are only used by Function VarPrefix
, and are only used once. I'd either move them inside the function...
Private Function VarPrefix(sVarType As String) As String
Const VariableTypes As String = "Variant, Integer, Long, Single, Double, Currency, Date, String, Boolean, Byte, LongLong, LongPtr, Collection, Object"
Const VariablePrefixes As String = "v, i, l, sgl, dbl, ccy, d, s, b, by, h, h, c, o"
...or simply inline the strings.
Miscellania
1.) This If
block is complete torture:
If Selection.Columns.Count > 4 And (Selection.Columns.Count - 4) Mod 2 <> 0 _ Then MsgBox "Selection is wrong, please try again", vbCritical + vbOKOnly, "Excel clsGen": End
It combines a line continuation and an instruction separator to give a single line If
statement that spans 2 lines and executes 2 statements. That's insanely difficult to read and is becoming is the source of numerous questions on SO. This is much, much, much better:
If Selection.Columns.Count > 4 And (Selection.Columns.Count - 4) Mod 2 <> 0 Then
MsgBox "Selection is wrong, please try again", vbCritical + vbOKOnly, "Excel clsGen"
Exit Sub
End If
Don't fight VBA's syntax - use it. The impetus to compact the code vertically won't be as great if the procedure isn't 321 lines long (see above).
2.) Related to the above, note also that End
is not the same thing as Exit Sub
. It forcibly terminates execution, meaning that it's up in the air as to whether rngRawInput
's reference count gets decremented. This is most likely a memory leak and I'd consider it a bug. Note also that it took me longer to catch this than any other bug in this code because it's obscured by the "single-line" If
statement (my eyes pick it out as End If
) - see above.
3.) This section of code "leaks" an initialized object outside of the loop that it's used in:
For i = LBound(arrName) To UBound(arrName) Set myMember = New clsGenClsMember With myMember '...[Snip]... End With Next
The variable myMember
holds one reference, and the implicit With
"placeholder" holds a second reference. If you merge the instantiation into the With
, it ensures that the object gets released at the end of the block when it goes out of scope:
For i = LBound(arrName) To UBound(arrName)
With New clsGenClsMember
'...[Snip]...
End With
Next
4.) VbMsgBoxStyle
is a set of bit flags. That means they shouldn't be added like vbCritical + vbOKOnly
. They should be combined with the Or
operator: vbCritical Or vbOKOnly
.
5.) There is almost zero validation for identifier names. What if I enter something into a cell with a newline in it? Or a variable name with a space? Or a name that begins with an underscore? Or a number? Or... etc. At a minimum, I would expect to see something like a regular expression to catch the most egregious of these.
Ironically, the only thing that is validated is that "Member name cannot be 'val'" . When I originally saw that, I thought to myself - "Oh, that's because Val
is a built in VBA function.". But there's no other name collision testing (although there probably should be). It strikes me more like this used to be the default parameter name in the generated class instead of Var
, but it was later renamed because Val
was hiding stuff...
6.) Speaking of validation, the member names are being validated in the wrong place. They're checked here (and have the plug forcibly pulled if they're too long - see the discussion of End
above)...
If Len(.Name) > cstMaxLenName Or Len(.Rights) > cstMaxLenRW Or Len(.VarTypeFull) > cstMaxLenVarType Then _ MsgBox "Member Name, RW statement, and/or Description are too long, please try again with something shorter.", vbCritical + vbOKOnly, "Excel clsGen": End
...but when they're used, they're coming from clsGenClsMember
unchecked:
With myMember sOutput = sOutput & "' - " & .Name & Space(cstMaxLenName - Len(.Name)) _ & .Rights & Space(cstMaxLenRW - Len(.Rights)) _ & .VarTypeFull & Space(cstMaxLenVarType - Len(.VarTypeFull)) _ & .Description & vbNewLine End With
This is a clear violation of separation of responsibilities, and I can't be the only one who sees irony in code that generates classes doing this. If the maximum Name
length for a clsGenClsMember
is 25, the class should be enforcing it, not the caller.
Note that this allows unchecked code like .Name & Space(cstMaxLenName - Len(.Name))
which throws if the class doesn't enforce this. This is borderline buggy.
7.) All of the code with place-holders and Replace
needs validation:
sPrint = "Private @p@VarName as @New @VarType" & vbNewLine sPrint = Replace(sPrint, "@VarName", .Name)
What happens if I use a place-holder in the input? It would probably be better to concatenate these instead.
8.) The list of intrinsic variables doesn't take types and enumerations into account. That means when it checks to see if a property should be generated as a Let
or a Set
in code like this...
sPrint = Replace(sPrint, "@New ", IIf(UBound(Filter(arrNonObjectVariables, .VarType, , vbTextCompare)) > -1, "", "New "))
...it is ignoring things like VbMsgBoxStyle
from above. There's not really a way to definitively know which one to use in all cases, because you can use Set
with a Variant
too. Barring going off to read the type libraries and figuring it out, this is likely best left to user input - I'd also consider this a bug.
Note also that this should be a responsibility of clsGenClsMember
, not the calling code.
9.) There is at least one declaration missing variable types:
Dim sArgumentPairs
Hungarian says that's a String
, but it lies - that's a Variant
(this highlights part of the problem with Hungarian notation...see above).
10.) Similar to #8, this default prefix in VarPrefix
...
'Else it is an Object VarPrefix = "o"
...is broken for the same way. E.g. Dim oNoImNotAnObject As MyType
...
There probably more ground to cover (I didn't even get to running code analysis on this), but I'll leave that to other reviewers as this is already running a tad long...
1 Full disclosure, I'm a contributor to that project.
2 Fuller disclosure, I implemented the Hungarian notation inspection in Rubberduck too.
-
1\$\begingroup\$ Comments are not for extended discussion; this conversation has been moved to chat. \$\endgroup\$rolfl– rolfl2019年02月06日 18:35:22 +00:00Commented Feb 6, 2019 at 18:35
This post is tagged with object-oriented, but what I'm seeing is very ironically procedural code.
It doesn't matter that this is "just a quick tool": we're here to write professional, quality code that is easy to read and maintain, performs well, and correctly. Comintern has given great feedback and highlighted a number of bugs and edge cases - which is exactly the purpose of this site and the reason one puts their code up for peer review, as opposed to just sharing it on GitHub.
Procedural code is essentially a sequence of executable statements. This main
procedure is exactly that. If this were actual object-oriented code, it might have read like this:
Public Sub Main()
Dim info As ClassInfo
Set info = GetClassInfo(Selection)
If info Is Nothing Then
MsgBox "Invalid Selection. Review debug output for details."
Exit Sub
End If
CreateClassModule info
End Sub
10 lines, including vertical whitespace. With proper abstraction, no procedure ever really needs to be much longer than that, and we know at a glance exactly what the procedure does, at a high level; if we need to look into the gory details of how a ClassInfo
object gets created, we need to drill down to the GetClassInfo
function, which we know will return Nothing
if something goes wrong; if we need to look into the gory details of how a class module gets created, we need to navigate to the CreateClassModule
procedure, which we know will take a ClassInfo
parameter.
CreateClassModule
might look like this:
Private Sub CreateClassModule(ByVal info As ClassInfo)
Dim path As String
path = GetDestinationFilePath(info.Name)
If path = vbNullString Then Exit Sub
With FileWriter.Create(path)
.Write info.ToString
End With
End Sub
Again, the procedure fits a handful of lines, and it's trivially easy to understand what's going on. There's a GetDestinationFilePath
function that probably prompts for a folder and returns a full path/filename (using the provided info.Name
), or an empty string if that prompt is cancelled by the user. It then proceeds to create some FileWriter
object that is responsible for the file I/O, and the file is trivially written by invoking its Write
method, given info.ToString
, which presumably builds a string representation of the class module. The FileWriter
class has a VB_PredeclaredId
attribute set to True
and exposes a Create
factory method (disclaimer: I wrote that article) that takes the path/filename of the file to be created; presumably the Class_Terminate
handler ensures the file handle is properly closed, but that's a low-level implementation detail that CreateClassModule
doesn't need to be bothered with and, as a matter of fact, isn't.
So we need a definition for this ClassInfo
object; we know we're going to need a ToString
method and a Name
property. Anything else? I can think of a number of things:
'@Folder("Tools.ClassBuilder")
'@ModuleDescription("Describes the metadata needed for generating a class module.")
Option Explicit
Private Type TClassInfo
Name As String
Description As String
IsPredeclared As Boolean
IsExposed As Boolean
Members As Collection
End Type
Private this As TClassInfo
Private Sub Class_Initialize()
Set this.Members = New Collection
End Sub
'@Description("Gets/sets the name of the class. Must be a valid identifier. Determines the value of the 'VB_Name' attribute.")
Public Property Get Name() As String
Name = this.Name
End Property
Public Property Let Name(ByVal value As String)
'TODO: validate input!
this.Name = value
End Property
'@Description("Gets/sets the description of the class. Determines the value of the 'VB_Description' attribute.")
Public Property Get Description() As String
Description = this.Description
End Property
Public Property Let Descrition(ByVal value As String)
'TODO: validate input!
this.Description = value
End Property
'@Description("Gets/sets the value of the 'VB_PredeclaredId' attribute.")
Public Property Get IsPredeclared() As Boolean
IsPredeclared = this.IsPredeclared
End Property
Public Property Let IsPredeclared(ByVal value As Boolean)
this.IsPredeclared = value
End Property
'@Description("Gets/sets the value of the 'VB_Exposed' and, indirectly, the 'VB_Creatable' attribute.")
Public Property Get IsExposed() As Boolean
IsExposed = this.IsExposed
End Property
Public Property Let IsExposed(ByVal value as Boolean)
this.IsExposed = value
End Property
'@Description("Adds the specified member metadata to this instance.")
Public Sub AddMember(ByVal info As MemberInfo)
'TODO: validate input!
this.Members.Add info, info.Key
End Sub
'@Description("Builds a string representing the entire contents of the class module.")
Public Function ToString() As String
With New StringBuilder
.AppendLine BuildHeaderInfo
Dim member As MemberInfo
For Each member In this.Members
.AppendLine member.ToString
Next
ToString = .ToString
End With
End Function
Private Function BuildHeaderInfo() As String
With New StringBuilder
.AppendLine "VERSION 1.0 CLASS"
.AppendLine "BEGIN"
.AppendLine " MultiUse = -1 'True"
.AppendLine "END"
.AppendLine "Attribute VB_Name = """ & this.Name & """"
.AppendLine "Attribute VB_GlobalNameSpace = False" ' no effect in VBA
.AppendLine "Attribute VB_Creatable = " & CStr(Not this.IsExposed)
.AppendLine "Attribute VB_PredeclaredId = " CStr(this.IsPredeclared)
.AppendLine "Attribute VB_Exposed = " CStr(this.IsExposed)
.AppendLine "Attribute VB_Description = """ & this.Description & """"
.AppendLine "'@ModuleDescription(""" & this.Description & """)"
.AppendLine "Option Explicit"
BuildHeaderInfo = .ToString
End With
End Function
Note the explicit ByVal
modifiers and the absolute absence of any kind of Hungarianesque prefixing scheme.
The '@Annotation
comments are picked up by Rubberduck (full disclosure: I am one of the administrators of this open-source VBIDE add-in project); they serve the dual purpose of documenting attribute values, and (through Rubberduck features) of enforcing these attribute values. Again note that the largest procedure here is a trivial series of .AppendLine
calls on some StringBuilder object that's responsible for efficiently building a string, and again these are private implementation details of the ToString
method, which does nothing more than append this file header info and each module members' own string representation to the result.
So there needs to be a MemberInfo
class - that's essentially the role your clsGenClsMember
class is playing. But your class is just data - an object encapsulates data, yes, but an object also performs operations on this data: from the code above we know a MemberInfo
at least needs a ToString
method, i.e. a way to turn its data into a string representation, and a Key
property that gets a string that combines the member kind (Sub
, Function
, PropertyGet
, PropertyLet
, PropertySet
) with the member's name, so that the keyed collection doesn't choke when a PropertyLet
member is added for, say, a Name
property when a PropertyGet
member already exists for it.
You get the idea by now: the GetClassInfo
procedure invoked in Main
creates a ClassInfo
instance, then trivially iterates the rows in the source Range
to create MemberInfo
instances and add them to the class metadata; if a property needs a getter and a setter, then two MemberInfo
instances are added.
This isn't any more complicated than writing procedural code. In fact, I would quite vehemently argue that it's simpler - and much easier to debug/maintain, extend/enhance, and test. Not because it's "just a quick tool". Writing object-oriented code isn't especially hard; it's about how we think about code, about how we model the problem to be solved. IMO this "quick little tool" could be a perfect excuse to learn to write modern, object-oriented VBA code.
-
\$\begingroup\$ Note: all code provided is air-code supplied for illustrative purposes; none of it was tested, and likely some adjustments are necessary (handling property members' backing fields comes to mind). \$\endgroup\$Mathieu Guindon– Mathieu Guindon2019年02月06日 16:51:27 +00:00Commented Feb 6, 2019 at 16:51
-
\$\begingroup\$ Never heard of the StringBuilder object before; great discovery today! On an other hand, I feel you guys should work on socializing with newcommers: Although usefull, these reviews are sadly full of unecessary and snobish wordings such as "ironically". The post is tagged as "Object Oriented" because the goal of the source code is to generate class modules. \$\endgroup\$Ama– Ama2019年02月06日 17:11:30 +00:00Commented Feb 6, 2019 at 17:11
-
\$\begingroup\$ @Ama I'll be honest, I was utterly thrilled yesterday when I saw your post. Then I saw how you kept defending the "but this is just a quick little tool for myself" standpoint, and I'll admit that did make me feel like reviewing it might not be worth the effort, since it wasn't clear whether you were even interested in improving this code in any way. Sorry this frustration transpired in my post and/or comments. As for OOP, as you can see there's much more to OOP than just using class modules. \$\endgroup\$Mathieu Guindon– Mathieu Guindon2019年02月06日 17:15:40 +00:00Commented Feb 6, 2019 at 17:15
-
1\$\begingroup\$ @Ama - FWIW, you can disable the inspection in RD if you're attached to that notation style. It's not uncommon for CRs to spark spirited debates about style preferences or for different reviewers to post wildly different suggestions. It certainly helps to go into it with the understanding of what you're going to get though. I'm usually more disappointed if I don't get a handful of critical comments for a CR question - that's why I post them. ;-) \$\endgroup\$Comintern– Comintern2019年02月06日 17:49:43 +00:00Commented Feb 6, 2019 at 17:49
-
1\$\begingroup\$ @Ama but you don't feel a need to segregate user classes from framework classes in .NET? Blending in is the whole point of conventions (i.e. PascalCase type & member names). I really don't want to drag this debate, but I see zero use in using HN in a statically typed language. Maybe if this were VBScript and everything had to be
Variant
, but in VBA/VB6 it just doesn't hold water IMO. As for IntelliSense, I guess I prefer typing "D" to get to "Description" ...so when RD starts hijacking IntelliSense and you can type "FSO" to get a "FileSystemObject", HN will die? ;-) \$\endgroup\$Mathieu Guindon– Mathieu Guindon2019年02月06日 18:02:32 +00:00Commented Feb 6, 2019 at 18:02
Updated source code, with the following comments from Comintern, and suggestion from Mathieu:
- Constants declarations now include types
- Additionnal warning regarding non-recognised variable types (enumerations, etc)
- One-Liners in the fashion of "If ABC Then Msgbox DEF: End" converted into several-liners
- The MyMember With-block has been optimized
- Missing type for sArgumentPairs has been added
- Var/Val inconsistency in data validation has been fixed
Also made the following updates:
- Simplified Class code (improved readability)
- Removed prefixing option as this was prone to generate debate over Hungarian style
STANDARD MODULE SOURCE CODE
Option Explicit
'##### GEN CLASS CODE FOR VBA #####
'Generates code in the Immediate Window
'Select in a Spreadsheet the list of Properties, Functions, and Methods to be incorporated within the Class.
'The row just above the selection provides the Class Name in the cell of column 1 of the selection, and an optionnal Description in column 2.
'Make sure your class Name begins with a 3-letters prefix (for example 'clsMyClassName').
'Each Row of the selection must represent a Member, and the Columns must be structured as follows: (x = must be provided, o = must not be provided, ? = can be provided)
'Column Property Function Method Comment
' - 1: Member Name x x x
' - 2: Member Variable Type x x o Variable Type of the Variable returned by Property or Function. Use "VarType Coll" to declare a Collection of 'VarType'.
' - 3: Member Rights x o o Defines if the Member is Read Only, Write Only, or Both: type 'R', 'W', or 'RW'.
' - 4: Member Description ? ? ? Will be inserted in the Class Summary Header, as well as in the Member Mini Header. Usually empty if the Member is a Property.
' - 5-6+: Member Input Variables o ? ? Pairs of value : column N is VarName, column N+1 is VarType. If more than one Input Variable is required, reapeat with columns 7-8, etc.
'Known non-Object Variable Types (Object variables require a Let and New statement)
'WARNING: Enumerations and user-defined Types are treated as Objects -> Changes to be made manually after Code Generation
Private Const cstNonObjectVariables As String = "Variant, Integer, Long, Single, Double, Currency, Date, String, Boolean, Byte, LongLong, LongPtr"
'Maximum lengths per column (for Class Summary Header)
Private Const cstMaxLenName As Long = 25
Private Const cstMaxLenRW As Long = 4
Private Const cstMaxLenVarType As Long = 25
Sub main()
'***** PREPARE DATA *****
'# Read and Verify Selection
Dim rngRawInput As Range
Set rngRawInput = Selection
If Selection.Columns.Count > 4 And (Selection.Columns.Count - 4) Mod 2 <> 0 Then
MsgBox "Selection is wrong, please try again", vbCritical + vbOKOnly, "Excel clsGen"
End
End If
If rngRawInput.Columns.Count < 6 Then Set rngRawInput = rngRawInput.Resize(, 6)
'# Save Selection Content
Dim sClassName As String
Dim sClassDescription As String
sClassName = rngRawInput.Offset(-1, 0).Cells(1, 1).Value2
sClassDescription = rngRawInput.Offset(-1, 0).Cells(1, 2).Value2
Dim arrName() As Variant
Dim arrVarType() As Variant
Dim arrRights() As Variant
Dim arrDescription() As Variant
Dim arrInputVars() As Variant
arrName = rngRawInput.Columns(1).Value2
arrVarType = rngRawInput.Columns(2).Value2
arrRights = rngRawInput.Columns(3).Value2
arrDescription = rngRawInput.Columns(4).Value2
arrInputVars = ActiveSheet.Range(Cells(rngRawInput.Row, rngRawInput.Column + 4), _
Cells(rngRawInput.Row + rngRawInput.Rows.Count - 1, rngRawInput.Column + rngRawInput.Columns.Count - 1)).Value2
'# Identify Selection Content Member Types and Populate relevant Collections
Dim cProperties As New Collection
Dim cFunctions As New Collection
Dim cMethods As New Collection
Dim myMember As clsGenClsMember
Dim i As Integer
Dim j As Integer
For i = LBound(arrName) To UBound(arrName)
With New clsGenClsMember
.Name = arrName(i, 1)
.VarType = Replace(Split(arrVarType(i, 1) & " ", " ")(VBAexcelBasics.FunctionsStrings.strCount(CStr(arrVarType(i, 1)), " ")), "Coll", "Collection", , , vbTextCompare) '"oVariable Coll" -> "Collection" (of oVariable type)
.VarTypeFull = arrVarType(i, 1)
.Rights = arrRights(i, 1)
.Description = arrDescription(i, 1)
.InputVars = Application.WorksheetFunction.Index(arrInputVars, i, 0)
If StrComp(.Name, "Var", vbTextCompare) = 0 Then
MsgBox "Member name cannot be 'Var', please try again with another name.", vbCritical + vbOKOnly, "Excel clsGen"
End
End If
If Len(.Name) > cstMaxLenName Or Len(.Rights) > cstMaxLenRW Or Len(.VarTypeFull) > cstMaxLenVarType Then
MsgBox "Member Name, RW statement, and/or Description are too long, please try again with something shorter.", vbCritical + vbOKOnly, "Excel clsGen"
End
End If
'Member is a Property
If .Name <> "" And .VarType <> "" And .Rights <> "" And .InputVars(1) = "" Then
cProperties.Add .Self
'Member is a Function
ElseIf .Name <> "" And .VarType <> "" And .Rights = "" And .InputVars(1) <> "" Then
cFunctions.Add .Self
'Member is a Method
ElseIf .Name <> "" And .VarType = "" And .Rights = "" Then
cMethods.Add .Self
'Unable to identify Member kind
Else
MsgBox "Unable to Identify Content of row " & i & " (" & .Name & "). Please verify and try again.", vbCritical + vbOKOnly, "Excel clsGen"
End
End If
End With
Next
'***** PRINT DATA *****
Dim sPrint As String
Dim sOutput As String
Dim arrNonObjectVariables() As String
arrNonObjectVariables = Split(cstNonObjectVariables, ", ")
'# Print Summary Header
sPrint = "'@ClassName" & vbNewLine _
& "'@ClassDescription" & vbNewLine _
sPrint = Replace(sPrint, "@ClassName", StrConv(Mid(sClassName, 4, Len(sClassName) - 3), vbUpperCase))
sPrint = Replace(sPrint, "@ClassDescription" & vbNewLine, IIf(sClassDescription = "", "", sClassDescription & vbNewLine))
sOutput = sOutput & sPrint
'Properties
sOutput = sOutput & vbNewLine _
& "'Properties:" & vbNewLine
For Each myMember In cProperties
With myMember
sOutput = sOutput & "' - " & .Name & Space(cstMaxLenName - Len(.Name)) _
& .Rights & Space(cstMaxLenRW - Len(.Rights)) _
& .VarTypeFull & Space(cstMaxLenVarType - Len(.VarTypeFull)) _
& .Description & vbNewLine
End With
Next
'Functions
sOutput = sOutput & vbNewLine _
& "'Functions:" & vbNewLine
For Each myMember In cFunctions
With myMember
sOutput = sOutput & "' - " & .Name & Space(cstMaxLenName + cstMaxLenRW - Len(.Name)) _
& .VarTypeFull & Space(cstMaxLenVarType - Len(.VarTypeFull)) _
& .Description & vbNewLine
End With
Next
'Methods
sOutput = sOutput & vbNewLine _
& "'Methods:" & vbNewLine
For Each myMember In cMethods
With myMember
sOutput = sOutput & "' - " & .Name & Space(cstMaxLenName - Len(.Name)) _
& .Description & vbNewLine
End With
Next
sOutput = sOutput & vbNewLine _
& "Option Explicit" & vbNewLine _
& vbNewLine _
& vbNewLine
'# Print Private Variables
For Each myMember In cProperties
With myMember
sPrint = "Private p@VarName as @New @VarType" & vbNewLine
sPrint = Replace(sPrint, "@VarName", .Name)
sPrint = Replace(sPrint, "@New ", IIf(UBound(Filter(arrNonObjectVariables, .VarType, , vbTextCompare)) > -1, "", "New "))
sPrint = Replace(sPrint, "@VarType", .VarType)
sOutput = sOutput & sPrint
End With
Next
'# Print Initialize
sPrint = vbNewLine _
& vbNewLine _
& vbNewLine _
& "'##### INITIALIZE #####" & vbNewLine _
& vbNewLine _
& "Private Sub class_Initialize()" & vbNewLine _
& " Debug.Print ""@ClassName initilized"" " & vbNewLine _
& "End Sub" & vbNewLine
sPrint = Replace(sPrint, "@ClassName", sClassName)
sOutput = sOutput & sPrint
'# Print Properties
sPrint = vbNewLine _
& vbNewLine _
& vbNewLine _
& "'##### PROPERTIES #####" & vbNewLine
sOutput = sOutput & sPrint
For Each myMember In cProperties
With myMember
'Prepare Print
sPrint = vbNewLine _
& vbNewLine _
& "'# @VARNAME" & vbNewLine _
& vbNewLine
If InStr(.Rights, "R") <> 0 Then sPrint = sPrint & "'@Description" & vbNewLine _
& "Public Property Get @VarName() as @VarType" & vbNewLine _
& " @Set @VarName = p@VarName" & vbNewLine _
& "End Property" & vbNewLine
If InStr(.Rights, "W") <> 0 Then sPrint = sPrint & "Public Property @LetSet @VarName(Var as @VarType)" & vbNewLine _
& " @Set p@VarName = Var" & vbNewLine _
& "End Property" & vbNewLine
'Replace PlaceHolders
sPrint = Replace(sPrint, "@VARNAME", UCase(.Name))
sPrint = Replace(sPrint, "@Description", .Description)
sPrint = Replace(sPrint, "@VarName", .Name)
sPrint = Replace(sPrint, "@VarType", .VarType)
sPrint = Replace(sPrint, "@Set ", IIf(UBound(Filter(arrNonObjectVariables, .VarType, , vbTextCompare)) > -1, "", "Set "))
sPrint = Replace(sPrint, "@LetSet", IIf(UBound(Filter(arrNonObjectVariables, .VarType, , vbTextCompare)) > -1, "Let", "Set"))
sOutput = sOutput & sPrint
End With
Next
'# Print Functions
sPrint = vbNewLine _
& vbNewLine _
& vbNewLine _
& "'##### FUNCTIONS #####" & vbNewLine
sOutput = sOutput & sPrint
Dim sArgumentPairs as String
For Each myMember In cFunctions
With myMember
'Prepare Print
sPrint = vbNewLine _
& vbNewLine _
& "'# @NAME" & vbNewLine _
& vbNewLine _
& "'@Description" & vbNewLine _
& "Public Function @Name(@ArgumentPairs) as @VarType" & vbNewLine _
& " " & vbNewLine _
& "End Function" & vbNewLine
'Replace PlaceHolders
sPrint = Replace(sPrint, "@NAME", UCase(.Name))
sPrint = Replace(sPrint, "@Description", .Description)
sPrint = Replace(sPrint, "@Name", .Name)
sPrint = Replace(sPrint, "@VarType", .VarType)
'Check if Arguments List provided
If .InputVars(1) = "" Then
sPrint = Replace(sPrint, "(@ArgumentPairs)", "")
Else
sArgumentPairs = ""
For i = LBound(.InputVars) To UBound(.InputVars) Step 2
If .InputVars(i) = "" Then Exit For
sArgumentPairs = sArgumentPairs & "ByVal " & .InputVars(i) & " as " & .InputVars(i + 1) & ", "
Next
sArgumentPairs = Left(sArgumentPairs, Len(sArgumentPairs) - Len(", "))
sPrint = Replace(sPrint, "@ArgumentPairs", sArgumentPairs)
End If
sOutput = sOutput & sPrint
End With
Next
'# Print Methods
sPrint = vbNewLine _
& vbNewLine _
& vbNewLine _
& "'##### METHODS #####" & vbNewLine
sOutput = sOutput & sPrint
For Each myMember In cMethods
With myMember
'Prepare Print
sPrint = vbNewLine _
& vbNewLine _
& "'# @NAME" & vbNewLine _
& vbNewLine _
& "'@Description" & vbNewLine _
& "Public Sub @Name(@ArgumentPairs)" & vbNewLine _
& " " & vbNewLine _
& "End Sub" & vbNewLine
'Replace PlaceHolders
sPrint = Replace(sPrint, "@NAME", UCase(.Name))
sPrint = Replace(sPrint, "@Description", .Description)
sPrint = Replace(sPrint, "@Name", .Name)
'Check if Arguments List provided
If .InputVars(1) = "" Then
sPrint = Replace(sPrint, "@ArgumentPairs", "")
Else
sArgumentPairs = ""
For i = LBound(.InputVars) To UBound(.InputVars) Step 2
If .InputVars(i) = "" Then Exit For
sArgumentPairs = sArgumentPairs & "ByVal " & .InputVars(i) & " as " & .InputVars(i + 1) & ", "
Next
sArgumentPairs = Left(sArgumentPairs, Len(sArgumentPairs) - Len(", "))
sPrint = Replace(sPrint, "@ArgumentPairs", sArgumentPairs)
End If
sOutput = sOutput & sPrint
End With
Next
'# Export Print Code to Immediate Window
Debug.Print sOutput
End Sub
CLASS MODULE SOURCE CODE (Name = clsGenClsMember)
'Stores the characteristics of one Member (one member per row within the user selected range)
Option Explicit
Public Name As String
Public VarType As String
Public VarTypeFull As String
Public Rights As String
Public Description As String
Public InputVars As Variant
'Allow self-reflection
Public Property Get Self() As clsGenClsMember
Set Self = Me
End Property
The updated code generates the following code, using the following input:
'CLIENTFILE
'Description here
'Properties:
' - Id R Long A cumulative Id number (attributed during initialization)
' - FirstName RW String First name
' - LastName RW String Last Name
' - DateOfBirth RW Date Date of Birth
' - Sales RW String Coll A collection of strings which represent sales ID numbers
' - Proposals RW clsProposal Coll A collection of clsProposal objects which represent the proposals sent in the past
'Functions:
' - NewProposal clsProposal Returns a Proposal for given sales parameters
'Methods:
' - SendBestWishes Sends a wishes card (why not?)
' - MakePremium Upgrades the client to Premium
Option Explicit
Private pId as Long
Private pFirstName as String
Private pLastName as String
Private pDateOfBirth as Date
Private pSales as New Collection
Private pProposals as New Collection
'##### INITIALIZE #####
Private Sub class_Initialize()
Debug.Print "clsClientFile initilized"
End Sub
'##### PROPERTIES #####
'# ID
'A cumulative Id number (attributed during initialization)
Public Property Get Id() as Long
Id = pId
End Property
'# FIRSTNAME
'First name
Public Property Get FirstName() as String
FirstName = pFirstName
End Property
Public Property Let FirstName(Var as String)
pFirstName = Var
End Property
'# LASTNAME
'Last Name
Public Property Get LastName() as String
LastName = pLastName
End Property
Public Property Let LastName(Var as String)
pLastName = Var
End Property
'# DATEOFBIRTH
'Date of Birth
Public Property Get DateOfBirth() as Date
DateOfBirth = pDateOfBirth
End Property
Public Property Let DateOfBirth(Var as Date)
pDateOfBirth = Var
End Property
'# SALES
'A collection of strings which represent sales ID numbers
Public Property Get Sales() as Collection
Set Sales = pSales
End Property
Public Property Set Sales(Var as Collection)
Set pSales = Var
End Property
'# PROPOSALS
'A collection of clsProposal objects which represent the proposals sent in the past
Public Property Get Proposals() as Collection
Set Proposals = pProposals
End Property
Public Property Set Proposals(Var as Collection)
Set pProposals = Var
End Property
'##### FUNCTIONS #####
'# NEWPROPOSAL
'Returns a Proposal for given sales parameters
Public Function NewProposal(ByVal Title as String, ByVal ExpDate as Date) as clsProposal
End Function
'##### METHODS #####
'# SENDBESTWISHES
'Sends a wishes card (why not?)
Public Sub SendBestWishes(ByVal Address as String)
End Sub
'# MAKEPREMIUM
'Upgrades the client to Premium
Public Sub MakePremium()
End Sub