7
\$\begingroup\$

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:

  1. Create a new sheet or chose an empty spot on a random sheet
  2. Type the name of your class in one cell
  3. All the cells below will contain the name of a member of your class
  4. The cells adjacent (to the right) of the step 3 cells will provide the type (if the member is a method, leave blank)
  5. 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)
  6. The cells adjacent to the step 5 cells will provide a description of the member (optional)
  7. 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
  8. Select the range containing your data (except the Class name, which will be located just above your selection)
  9. Run subroutine Main (code provided below)
  10. 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.

enter image description here

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
Mathieu Guindon
75.5k18 gold badges194 silver badges467 bronze badges
asked Feb 5, 2019 at 15:19
\$\endgroup\$
9
  • 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\$ Commented 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\$ Commented 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\$ Commented 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\$ Commented 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\$ Commented Feb 6, 2019 at 14:37

3 Answers 3

7
\$\begingroup\$

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.

answered Feb 5, 2019 at 21:50
\$\endgroup\$
1
  • 1
    \$\begingroup\$ Comments are not for extended discussion; this conversation has been moved to chat. \$\endgroup\$ Commented Feb 6, 2019 at 18:35
3
\$\begingroup\$

This post is tagged with , 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.

answered Feb 6, 2019 at 16:40
\$\endgroup\$
9
  • \$\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\$ Commented 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\$ Commented 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\$ Commented 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\$ Commented 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\$ Commented Feb 6, 2019 at 18:02
0
\$\begingroup\$

Updated source code, with the following comments from Comintern, and suggestion from Mathieu:

  1. Constants declarations now include types
  2. Additionnal warning regarding non-recognised variable types (enumerations, etc)
  3. One-Liners in the fashion of "If ABC Then Msgbox DEF: End" converted into several-liners
  4. The MyMember With-block has been optimized
  5. Missing type for sArgumentPairs has been added
  6. Var/Val inconsistency in data validation has been fixed

Also made the following updates:

  1. Simplified Class code (improved readability)
  2. 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:

enter image description here

'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
answered Feb 6, 2019 at 15:50
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.