统计代码行的源程序

时　间:2004-12-23 00:00:00
作　者:竹笛   ID：8  城市：上海  QQ：2851379730
摘　要:统计代码行的源程序 
正　文:

当您有开发完一个作品时，也许你希望知道你的代码写了多少行，这时你可以使用下面的代码来统计它，不过有些耗时，我统计了一下我开发的一个软件，共8108行，运行了近20分钟：-D

在你的程序中新增一模块，命名为：mdlCountLines，并复制下面的代码到该模块中：

Public Function fCountLines() As Long
'   Code to count the number of lines of code in the current database
    On Error GoTo E_Handle
    Dim db As Database
    Dim ctr As Container
    Dim doc As Document
    Dim frm As Form
    Dim rpt As Report
    Dim mdl As Module
    Dim lngCount As Long
    Dim intCount As Integer, intLoop As Integer
    Set db = CurrentDb
    Set ctr = db.Containers!Forms
    For Each doc In ctr.Documents
        DoCmd.OpenForm doc.Name, acDesign, , , , acHidden
        Set frm = Forms(doc.Name)
        If frm.HasModule = True Then
            Set mdl = frm.Module
            intCount = mdl.CountOfLines
            For intLoop = 1 To intCount
                If Len(mdl.Lines(intLoop, 1)) > 0 And Left(Trim(mdl.Lines(intLoop, 1)), 1) <> "'" Then
                    lngCount = lngCount + 1
                End If
            Next intLoop
            Set mdl = Nothing
        End If
        DoCmd.Close acForm, doc.Name
        Set frm = Nothing
    Next doc
    Set ctr = db.Containers!Reports
    For Each doc In ctr.Documents
        DoCmd.OpenReport doc.Name, acViewDesign
        Set rpt = Reports(doc.Name)
        If rpt.HasModule = True Then
            Set mdl = rpt.Module
            intCount = mdl.CountOfLines
            For intLoop = 1 To intCount
                If Len(mdl.Lines(intLoop, 1)) > 0 And Left(Trim(mdl.Lines(intLoop, 1)), 1) <> "'" Then
                    lngCount = lngCount + 1
                End If
            Next intLoop
            Set mdl = Nothing
        End If
        DoCmd.Close acReport, doc.Name
        Set mdl = Nothing
        End If
    Next doc
    fCountLines = lngCount
fExit:
    On Error Resume Next
    Set ctr = Nothing
    Set db = Nothing
    Exit Function
E_Handle:
    MsgBox Err.Description & vbCrLf & "fCountLines", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume fExit
End Function