Trucos y tretas en Excel VBA para programadores - Generador de código para manejador de objetos

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
   
    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.
Accede a Rankia
¡Sé el primero en comentar!