Cuando diseñas objetos en Excel VBA conforme a lo dicho en el post anterior Trucos y tretas en Excel VBA para programadores (usando clases y objetos) te das cuenta de que a veces los objetos pueden llegar a tener muchas propiedades, eventos y métodos (funcionaes y procedimientos), y esto puede traer una cantidad de código que es terriblemente aburrido de escribir y donde puedes cometer incontables errores.
Construye la hoja de Excel con las siguientes columnas. He puesto algunos ejemplos de valores de la plantilla de código para un class module.
Friend
Aqui he de introducir el concepto de métodos y propiedades "friend".
Un procedimiento definido como friend permite que el procedimiento sea llamado desde módulos que están fuera de la clase, pero que forman parte del proyecto dentro del cual se define la clase. Esto modifica la definición de un procedimiento en un módulo de clase para hacer que el procedimiento sea invocable desde módulos que están fuera de la clase.
La macro
El botón debe invocar al método GenerateClassText de la macro que muestro a continuación. Este código generará un archivo llamado CustomClass.bas en el mismo directorio del archivo de Excel.
He aquí el código
Construye la hoja de Excel con las siguientes columnas. He puesto algunos ejemplos de valores de la plantilla de código para un class module.
Friend
Aqui he de introducir el concepto de métodos y propiedades "friend".
Un procedimiento definido como friend permite que el procedimiento sea llamado desde módulos que están fuera de la clase, pero que forman parte del proyecto dentro del cual se define la clase. Esto modifica la definición de un procedimiento en un módulo de clase para hacer que el procedimiento sea invocable desde módulos que están fuera de la clase.
La macro
El botón debe invocar al método GenerateClassText de la macro que muestro a continuación. Este código generará un archivo llamado CustomClass.bas en el mismo directorio del archivo de Excel.
He aquí el código
Sub GenerateClassText()
Dim sHeader As String
Dim sProperties As String
Dim sVarName As String
Dim sPropertyType As String
Dim sDataType As String
Dim sMethods As String
Dim sNewMethod As String
sHeader = ""
sProperties = ""
sMethods = ""
sNewMethod = ""
sEvents = ""
sNewEvent = ""
LR = LastRow
For i = 2 To LR
sVarName = CStr(Cells(i, 1))
If sVarName <> "" Then
sPropertyType = CStr(Cells(i, 2))
sDataType = CStr(Cells(i, 3))
bIsDefault = CBool(Cells(i, 4))
sHeader = sHeader & HeaderCode(sVarName, sPropertyType, sDataType)
sProperties = sProperties & PropertyCode(sVarName, sPropertyType, sDataType, sDataTypebIsDefault)
End If
'METHODS
sMethodName = CStr(Cells(i, 6))
sArgument = CStr(Cells(i, 9))
sReturn = CStr(Cells(i, 7))
bIsFriend = CBool(Cells(i, 8))
aArgumentType = CStr(Cells(i, 10))
If Not (sMethodName = "" And sArgument <> "") Then
If sNewMethod <> "" Then
sNewMethod = sNewMethod & ")" & Suffix & vbCrLf
sNewMethod = sNewMethod & "End " & MethodSecondWord & vbCrLf
sMethods = sMethods & sNewMethod
sNewMethod = ""
End If
If bIsFriend Then
MethodFirstWord = "Friend"
Else
MethodFirstWord = "Public"
End If
If sReturn <> "" Then
MethodSecondWord = "Function"
Suffix = " As " & sArgument
Else
MethodSecondWord = "Sub"
Suffix = ""
End If
If sMethodName <> "" Then
sNewMethod = vbCrLf & MethodFirstWord & " " & MethodSecondWord & " " & sMethodName & "("
End If
End If
If sArgument <> "" Then
Select Case Right(sNewMethod, 1)
Case "("
Separator = ""
Case Else
Separator = ", "
End Select
sNewMethod = sNewMethod & Separator & sArgument & " As " & aArgumentType
End If
'EVENTS
sEventName = CStr(Cells(i, 12))
sArgument = CStr(Cells(i, 13))
sArgumentType = CStr(Cells(i, 14))
If Not (sEventName = "" And sArgument <> "") Then
If sNewEvent <> "" Then
sNewEvent = sNewEvent & ")" & vbCrLf
sEvents = sEvents & sNewEvent
sNewEvent = ""
End If
If sEventName <> "" Then
sNewEvent = "Public Event " & sEventName & "("
End If
End If
If sArgument <> "" Then
Select Case Right(sNewEvent, 1)
Case "("
Separator = ""
Case Else
Separator = ", "
End Select
sNewEvent = sNewEvent & Separator & sArgument & " As " & sArgumentType
End If
Next i
sHowToTriggerEvents = "'To fire this event, use RaiseEvent with the following syntax:" & vbCrLf
sHowToTriggerEvents = sHowToTriggerEvents & "'RaiseEvent Evento1[(arg1, arg2, ... , argn)]" & vbCrLf
Open "CustomClass.bas" For Output As #1
Print #1, sHeader & vbCrLf & sHowToTriggerEvents & sEvents & vbCrLf & sMethods & vbCrLf & sProperties
Close #1
End Sub
Function LastRow() As Long
'Find last row
ActiveCell.SpecialCells(xlLastCell).Select
LastRow = ActiveCell.Row
End Function
Function HeaderCode(sVarName, sPropertyType, sDataType) As String
HeaderCode = ""
Select Case sPropertyType
Case "PublicProperty"
HeaderCode = HeaderCode & "Public mvar" & sVarName & " As " & sDataType & " 'local copy" & vbCrLf
Case "PublicVariable"
HeaderCode = HeaderCode & "Public mvar" & sVarName & " As " & sDataType & vbCrLf
Case "FriendlyProperty"
HeaderCode = HeaderCode & "Private mvar" & sVarName & " As " & sDataType & " 'local copy" & vbCrLf
End Select
End Function
Function PropertyCode(sVarName, sPropertyType, sDataType, sDataTypebIsDefault) As String
Select Case sPropertyType
Case "PublicProperty"
PropertyFirstWord = "Public"
Case "FriendlyProperty"
PropertyFirstWord = "Friend"
End Select
PropertyCode = ""
PropertyCode = PropertyCode & PropertyFirstWord & " Property Let " & sVarName & "(ByVal vData As " & sDataType & ")" & vbCrLf
PropertyCode = PropertyCode & "'used when assigning a value to the property, on the left side of an assignment." & vbCrLf
PropertyCode = PropertyCode & "'Syntax: X." & sVarName & " = 5" & vbCrLf
PropertyCode = PropertyCode & " mvar" & sVarName & " = vData" & vbCrLf
PropertyCode = PropertyCode & "End Property" & vbCrLf
PropertyCode = PropertyCode & "" & vbCrLf
PropertyCode = PropertyCode & PropertyFirstWord & " Property Set " & sVarName & "(ByVal vData As Object)" & vbCrLf
PropertyCode = PropertyCode & "'used when assigning an Object to the property, on the left side of a Set statement." & vbCrLf
PropertyCode = PropertyCode & "'Syntax: Set x." & sVarName & " = Form1" & vbCrLf
PropertyCode = PropertyCode & " Set mvar" & sVarName & " = vData" & vbCrLf
PropertyCode = PropertyCode & "End Property" & vbCrLf
PropertyCode = PropertyCode & "" & vbCrLf
PropertyCode = PropertyCode & PropertyFirstWord & " Property Get " & sVarName & "() As " & sDataType & vbCrLf
PropertyCode = PropertyCode & "'used when retrieving value of a property, on the right side of an assignment." & vbCrLf
PropertyCode = PropertyCode & "'Syntax: Debug.Print X." & sVarName & vbCrLf
PropertyCode = PropertyCode & " If IsObject(mvar" & sVarName & ") Then" & vbCrLf
PropertyCode = PropertyCode & " Set " & sVarName & " = mvar" & sVarName & vbCrLf
PropertyCode = PropertyCode & " Else" & vbCrLf
PropertyCode = PropertyCode & " " & sVarName & " = mvar" & sVarName & vbCrLf
PropertyCode = PropertyCode & " End If" & vbCrLf
PropertyCode = PropertyCode & "End Property" & vbCrLf
PropertyCode = PropertyCode & "" & vbCrLf
End Function
Los valores que debes usar en la hoja de Excel son los siguientes.
TRUE
FALSE
PublicProperty
FriendlyProperty
PublicVariable
Byte
Boolean
Integer
Long
Single
Double
Currency
Date
String
Variant
Object
Collection
Con este material puedes ahorrarte horas o hasta días de trabajo. Un buen manejador de objetos puede requerir muchos métodos, propiedades y eventos, y este código hace que crear el código de la clase sea cosa de minutos, sin los errores asociados. Será cosa de listar propiedades, métodos, eventos y sus parámetros (argumentos).
Si eres desafortunado y usas Mac, la macro no te va a servir, porque no te dejará salvar el archivo de texto con el código. Mejor cómprate una PC. Cuando se trata de macros de Excel, Mac se porta muy mal.
Antes de generar el c'odigo con la macro, debes revisar muy bien la información, porque si te equivocas en este punto, depurar el código va a ser lento y complicado. Es mejor que hagas triple chequeo y así te ahorrarás horas de depuración.
Fe de erratas: Habia unos bugs antes de enero 26. Si usaste el codigo antes de esa fecha, recomiendo que reemplaces el codigo con lo que esta en el post.