Option Compare Database
Option Explicit
Public Function AbrirEstadisticas()
DoCmd.OpenForm "VBIDEEstadisticas"
End Function
Public Function VBIDE_Estadisticas() As Variant
'---------------------------------------------------------------------------------------------------------------------------------------------------
' Fuente : https://access-global.net/vbide-algunas-estadisticas/
'---------------------------------------------------------------------------------------------------------------------------------------------------
' Título : EstadisticasReferencias
' Autor original : Luis Viadel
' Creado : desconocido
' Colaboradores : Alba Salvá
' Propósito : Obtener cirtos valores de propiedades del VBIDE del programa host, ya que se realiza la acción desde un complemento
' Argumento/s : no tiene argumentos
' Devolución : la función devuelve un matriz con todos los valores que queremos calcular
'---------------------------------------------------------------------------------------------------------------------------------------------------
' Referencias :
'---------------------------------------------------------------------------------------------------------------------------------------------------
' Test: : Para adaptar este código en tu aplicación puedes basarte en este procedimiento test. Copia el bloque siguiente código al
' portapapeles y pega en el editor de VBA, en el evento del objeto que desees. En el test lo hacemos desde la carga de un form
' Descomentar la línea que nos interese y pulsar F5 para ver su funcionamiento.
'
'Private Sub Form_Load()
'Dim VBIDEStats As Variant
'
' VBIDEStats = VBIDE_Estadisticas
'
'End Sub
'
'---------------------------------------------------------------------------------------------------------------------------------------------------
Dim objRef As VBIDE.Reference
Dim objRefs As VBIDE.References
Dim RefNum As Integer
Dim vbc As VBIDE.VBComponent
Dim vbcProjects As VBIDE.VBProjects
Dim vbcProject As VBIDE.VBProject
Dim NumStats As Variant
Dim NumMods As Integer, NumMod1 As Integer, NumMod2 As Integer
Dim NumMod3 As Integer, NumMod4 As Integer, NumMod5 As Integer
Dim NumProcs As Integer
Dim NumLinProcs As Long
Dim NumLinProcsCabecera As Long
Dim lngLastLine As Long, lngStartLine As Long
Dim lngLastLine1 As Long, lngStartLine1 As Long
Dim lngPublic As Long, lngPrivate As Long, lngComment As Long
Dim lngSub As Long, lngFunction As Long, lngVariables As Long
'Calculamos el número de referencias
Set objRefs = Application.VBE.ActiveVBProject.References
For Each objRef In objRefs
RefNum = RefNum + 1
Next
Set objRef = Nothing
'Leyenda para módulos
'NumMod1=Número de módulos estándar
'NumMod2=Número de módulos de clase
'NumMod3=Número de UserForms
'NumMod4=Número de Formularios
'Nummod5=Número de informes
'Inicializamos todas las variables
NumMod1 = 0
NumMod2 = 0
NumMod3 = 0
NumMod4 = 0
NumMod5 = 0
'Localizamos el VBProject correcto, porque si no, nos mostrará siempre el del complemento
Set vbcProjects = Application.VBE.VBProjects
For Each vbcProject In vbcProjects
If vbcProject.Name <> "VBIDE_Estadisticas" Then
If vbcProject.Name <> "ACWZTOOL" Then
'Recorremos los módulos y vamos revisando sus tipos
For Each vbc In vbcProject.VBComponents
Debug.Print vbc.Name
NumMods = NumMods + 1
Select Case vbc.Type
Case 1
NumMod1 = NumMod1 + 1
Case 2
NumMod2 = NumMod2 + 1
Case 3
NumMod3 = NumMod3 + 1
Case 100
If Left(vbc.Name, 4) = "Form" Then
NumMod4 = NumMod4 + 1
Else
NumMod5 = NumMod5 + 1
End If
End Select
Next
Exit For
End If
End If
Next
Set vbcProjects = Nothing
'Repetimos la operación para los procedimientos
'Inicializamos las variables
NumLinProcsCabecera = 0
NumLinProcs = 0
NumProcs = 0
lngPublic = 0
lngPrivate = 0
lngComment = 0
lngSub = 0
lngFunction = 0
lngLastLine = 0
lngStartLine = 0
'Recorremos todos los módulos
Set vbcProjects = Application.VBE.VBProjects
For Each vbcProject In vbcProjects
If vbcProject.Name <> "VBIDE_Estadísticas" Then
If vbcProject.Name <> "ACWZTOOL" Then
For Each vbc In vbcProject.VBComponents
With vbc.CodeModule
lngStartLine = .CountOfDeclarationLines + 1
lngLastLine = .CountOfLines
lngLastLine1 = .CountOfLines
lngStartLine1 = .CountOfDeclarationLines + 1
NumLinProcsCabecera = NumLinProcsCabecera + .CountOfDeclarationLines
NumLinProcs = NumLinProcs + .CountOfLines - .CountOfDeclarationLines
'Contamos los procedimientos
Do Until lngStartLine >= .CountOfLines
lngStartLine = lngStartLine + .ProcCountLines(.ProcOfLine(lngStartLine, vbext_pk_Proc), vbext_pk_Proc)
NumProcs = NumProcs + 1
Loop
'Buscamos concepto a concepto
For lngStartLine = lngStartLine1 To lngLastLine1
If vbc.CodeModule.Find("Public Sub", lngStartLine, 1, lngStartLine, 10) = True Then
lngSub = lngSub + 1
End If
Next
For lngStartLine = lngStartLine1 To lngLastLine1
If vbc.CodeModule.Find("Private Sub", lngStartLine, 1, lngStartLine, 11) = True Then
lngSub = lngSub + 1
End If
Next
For lngStartLine = lngStartLine1 To lngLastLine1
If vbc.CodeModule.Find("Public Function", lngStartLine, 1, lngStartLine, 15) = True Then
lngFunction = lngFunction + 1
End If
Next
For lngStartLine = lngStartLine1 To lngLastLine1
If vbc.CodeModule.Find("Private Function", lngStartLine, 1, lngStartLine, 16) = True Then
lngFunction = lngFunction + 1
End If
Next
'Recorremos las líneas de código para localizar los comentarios
For lngStartLine = lngStartLine1 To lngLastLine1
If vbc.CodeModule.Find("'", lngStartLine, 1, lngStartLine, 10) = True Then lngComment = lngComment + 1
Next
End With
Exit For
Next
End If
End If
Next
Set vbcProjects = Nothing
VBIDE_Estadisticas = Array(RefNum, NumMods, NumMod1, NumMod2, NumMod3, NumMod4, NumMod5, NumLinProcsCabecera, NumLinProcs, NumProcs, lngComment, lngSub, lngFunction)
End Function
