Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > 源码示例

统计代码行的源程序

时 间: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



Access软件网QQ交流群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助