✔ Programação GLOBAL®: VBA Access - Número de linhas de código na aplicação

VBA Access - Número de linhas de código na aplicação

Este é o típico artigo de MS Access voltado para o desenvolvedor. Como contar o Nº de linhas de código?

O código abaixo retornará o número de linhas de código contidas na sua aplicação de banco de dados corrente. Contará do início do seu primeiro módulo até as linhas de código existentes nos seus formulários e relatórios. Opcionalmente poderá listar o número das linhas em cada módulo e/ou obter o resumo numérico para cada tipo de módulo.

Para usar o código na sua aplicação, crie um novo módulo, e cole este código abaixo nele:

Option Compare Database
Option Explicit

'Purpose: Count the number of lines of code in your database.

Private Const micVerboseSummary = 1

Private Const micVerboseListAll = 2

Public Function CountLines(Optional iVerboseLevel As Integer = 3) As Long
On Error GoTo Err_Handler

'Purpose: Count the number of lines of code in modules of current database.

'Requires: Access 2000 or later.
'Argument: This number is a bit field, indicating what should print to the Immediate Window:

' 0 displays nothing
' 1 displays a summary for the module type (form, report, stand-alone.)

' 2 list the lines in each module
' 3 displays the summary and the list of modules.

'Notes: Code will error if dirty (i.e. the project is not compiled and saved.)

' Just click Ok if a form/report is assigned to a non-existent printer.

' Side effect: all modules behind forms and reports will be closed.

' Code window will flash, since modules cannot be opened hidden.

Dim accObj As AccessObject 'Cada módulo/formulário/relatório.
Dim strDoc As String 'Nome de cada formulário/relatório.

Dim lngObjectCount As Long 'Número dos módulos/formulários/relatórios
Dim lngObjectTotal As Long 'Total do número de objetos.

Dim lngLineCount As Long 'Número de linhas por tipo de objeto.
Dim lngLineTotal As Long 'Total do número de linhas para todos os tipos de objetos.

Dim bWasOpen As Boolean 'Flag para indicar se formulário/relatório está aberto ou foi aberto.

'Módulo de espera.

Let lngObjectCount = 0&
Let lngLineCount = 0&

For Each accObj In CurrentProject.AllModules
'OPTIONAL: TO EXCLUDE THE CODE IN THIS MODULE FROM THE COUNT:

' a) Uncomment the If ... and End If lines (3 lines later), by removing the single-quote.
' b) Replace MODULE_NAME with the name of the module you saved this in (e.g. "Module1")
' c) Check that the code compiles after your changes (Compile on Debug menu.)

'If accObj.Name <> "MODULE_NAME" Then

Let lngObjectCount = lngObjectCount + 1&
Let lngLineCount = lngLineCount + GetModuleLines(accObj.Name, True, iVerboseLevel)

'End If
Next

Let lngLineTotal = lngLineTotal + lngLineCount

Let lngObjectTotal = lngObjectTotal + lngObjectCount

If (iVerboseLevel And micVerboseSummary) <> 0 Then
Debug.Print lngLineCount & " line(s) in " & lngObjectCount & " stand-alone module(s)"

Debug.Print
End If

' Módulos dentro do formulários.
Let lngObjectCount = 0&

Let lngLineCount = 0&

For Each accObj In CurrentProject.AllForms
Let strDoc = accObj.Name

Let bWasOpen = accObj.IsLoaded

If Not bWasOpen Then
DoCmd.OpenForm strDoc, acDesign, WindowMode:=acHidden
End If

If Forms(strDoc).HasModule Then
Let lngObjectCount = lngObjectCount + 1&
Let lngLineCount = lngLineCount + GetModuleLines("Form_" & strDoc, False, iVerboseLevel)

End If

If Not bWasOpen Then
DoCmd.Close acForm, strDoc, acSaveNo
End If
Next

Let lngLineTotal = lngLineTotal + lngLineCount

Let lngObjectTotal = lngObjectTotal + lngObjectCount

If (iVerboseLevel And micVerboseSummary) <> 0 Then
Debug.Print lngLineCount & " line(s) in " & lngObjectCount & " module(s) behind forms"

Debug.Print
End If

'Módulos dentro dos relatórios.
Let lngObjectCount = 0&

Let lngLineCount = 0&

For Each accObj In CurrentProject.AllReports
Let strDoc = accObj.Name

Let bWasOpen = accObj.IsLoaded

If Not bWasOpen Then
'na versão Access 2000, remova o parâmetro ", WindowMode:=acHidden" da linha abaixo.

DoCmd.OpenReport strDoc, acDesign, WindowMode:=acHidden
End If

If Reports(strDoc).HasModule Then
Let lngObjectCount = lngObjectCount + 1&

Let lngLineCount = lngLineCount + GetModuleLines("Report_" & strDoc, False, iVerboseLevel)
End If

If Not bWasOpen Then

DoCmd.Close acReport, strDoc, acSaveNo
End If
Next

Let lngLineTotal = lngLineTotal + lngLineCount
Let lngObjectTotal = lngObjectTotal + lngObjectCount

If (iVerboseLevel And micVerboseSummary) <> 0 Then
Debug.Print lngLineCount & " linha(s) no(s) " & lngObjectCount & " módulo(s) dentro do(s) relatório(s)"
Debug.Print lngLineTotal & " linha(s) no(s) " & lngObjectTotal & " módulo(s)"

End If

Let CountLines = lngLineTotal

Exit_Handler:
Exit Function

Err_Handler:
Select Case Err.Number

Case 29068& 'Este erro ocorre atualmente em GetModuleLines()
MsgBox "Não posso completar a operação." & vbCrLf & "Certifique-se de que o código tenha sido previamente Compilado e Salvo."

Case Else
MsgBox "Erro: " & Err.Number & " - " & Err.Description
End Select

Resume Exit_Handler
End Function

Private Function GetModuleLines(strModule As String, bIsStandAlone As Boolean, iVerboseLevel As Integer) As Long

'Usage: Evocada por CountLines().
'Note: Do not use error handling: must pass error back to parent routine.

Dim bWasOpen As Boolean 'Flag aplicado somente para módulos standalone.

If bIsStandAlone Then
Let bWasOpen = CurrentProject.AllModules(strModule).IsLoaded
End If

If Not bWasOpen Then
DoCmd.OpenModule strModule
End If

If (iVerboseLevel And micVerboseListAll) <> 0 Then
Debug.Print Modules(strModule).CountOfLines, strModule
End If

Let GetModuleLines = Modules(strModule).CountOfLines

If Not bWasOpen Then
DoCmd.Close acModule, strModule, acSaveYes
End If
End Function