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
Sub GenerateClassText() Dim sHeader As String Dim sProperties As String
Dim sVarName As String Dim sPropertyType As String Dim sDataType As String
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.
