access vba计算各个模块代码行数
- 2019-05-29 15:49:00
- tmtony8
- 转贴:
- Allen Browne's Database and Training
- 4397
在编写程序的时候,是否有想过看看自己写了多少行代码呢?当然代码行数不是衡量工作量的标准了。
下面代码能返回当前数据库中的代码行数。包括独立模块,窗体和报表的代码行数。
同时,也列出每个对象中的行数,和给出每种类型模块的数量和每种类型的行数的摘要。
在立即窗口(Ctrl + G)中输入?countLines 运行代码
Option Compare Database Option Explicit 'Purpose: Count the number of lines of code in your database. 'Author: Allen Browne (allen@allenbrowne.com) 'Release: 26 November 2007 'Copyright: None. You may use this and modify it for any database you write. ' All we ask is that you acknowledge the source (leave these comments in your code.) 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 'Each module/form/report. Dim strDoc As String 'Name of each form/report Dim lngObjectCount As Long 'Number of modules/forms/reports Dim lngObjectTotal As Long 'Total number of objects. Dim lngLineCount As Long 'Number of lines for this object type. Dim lngLineTotal As Long 'Total number of lines for all object types. Dim bWasOpen As Boolean 'Flag to leave form/report open if it was open. 'Stand-alone modules. lngObjectCount = 0& 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 lngObjectCount = lngObjectCount + 1& lngLineCount = lngLineCount + GetModuleLines(accObj.Name, True, iVerboseLevel) 'End If Next lngLineTotal = lngLineTotal + lngLineCount lngObjectTotal = lngObjectTotal + lngObjectCount If (iVerboseLevel And micVerboseSummary) <> 0 Then Debug.Print lngLineCount & " line(s) in " & lngObjectCount & " stand-alone module(s)" Debug.Print End If 'Modules behind forms. lngObjectCount = 0& lngLineCount = 0& For Each accObj In CurrentProject.AllForms strDoc = accObj.Name bWasOpen = accObj.IsLoaded If Not bWasOpen Then DoCmd.OpenForm strDoc, acDesign, WindowMode:=acHidden End If If Forms(strDoc).HasModule Then lngObjectCount = lngObjectCount + 1& lngLineCount = lngLineCount + GetModuleLines("Form_" & strDoc, False, iVerboseLevel) End If If Not bWasOpen Then DoCmd.Close acForm, strDoc, acSaveNo End If Next lngLineTotal = lngLineTotal + lngLineCount lngObjectTotal = lngObjectTotal + lngObjectCount If (iVerboseLevel And micVerboseSummary) <> 0 Then Debug.Print lngLineCount & " line(s) in " & lngObjectCount & " module(s) behind forms" Debug.Print End If 'Modules behind reports. lngObjectCount = 0& lngLineCount = 0& For Each accObj In CurrentProject.AllReports strDoc = accObj.Name bWasOpen = accObj.IsLoaded If Not bWasOpen Then 'In Access 2000, remove the ", WindowMode:=acHidden" from the next line. DoCmd.OpenReport strDoc, acDesign, WindowMode:=acHidden End If If Reports(strDoc).HasModule Then lngObjectCount = lngObjectCount + 1& lngLineCount = lngLineCount + GetModuleLines("Report_" & strDoc, False, iVerboseLevel) End If If Not bWasOpen Then DoCmd.Close acReport, strDoc, acSaveNo End If Next lngLineTotal = lngLineTotal + lngLineCount lngObjectTotal = lngObjectTotal + lngObjectCount If (iVerboseLevel And micVerboseSummary) <> 0 Then Debug.Print lngLineCount & " line(s) in " & lngObjectCount & " module(s) behind reports" Debug.Print lngLineTotal & " line(s) in " & lngObjectTotal & " module(s)" End If CountLines = lngLineTotal Exit_Handler: Exit Function Err_Handler: Select Case Err.Number Case 29068& 'This error actually occurs in GetModuleLines() MsgBox "Cannot complete operation." & vbCrLf & "Make sure code is compiled and saved." Case Else MsgBox "Error " & 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: Called by CountLines(). 'Note: Do not use error handling: must pass error back to parent routine. Dim bWasOpen As Boolean 'Flag applies to standalone modules only. If bIsStandAlone Then 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 GetModuleLines = Modules(strModule).CountOfLines If Not bWasOpen Then DoCmd.Close acModule, strModule, acSaveYes End If End Function
Provided by Allen Browne, November 2007. Modified January 2008
阿超翻译修改
Access数据库自身
- office课程播放地址及课程明细
- Excel Word PPT Access VBA等Office技巧学习平台
- 将( .accdb) 文件格式数据库转换为早期版本(.mdb)的文件格式
- 将早期的数据库文件格式(.mdb)转换为 (.accdb) 文件格式
- KB5002984:配置 Jet Red Database Engine 数据库引擎和访问连接引擎以阻止对远程数据库的访问(remote table)
- Access 365 /Access 2019 数据库中哪些函数功能和属性被沙箱模式阻止(如未启动宏时)
- Access Runtime(运行时)最全的下载(2007 2010 2013 2016 2019 Access 365)
Access Activex第三方控件
- Activex控件或Dll 在某些电脑无法正常注册的解决办法(regsvr32注册时卡住)
- office使用部分控件时提示“您没有使用该ActiveX控件许可的问题”的解决方法
- RTF文件(富文本格式)的一些解析
- Access树控件(treeview) 64位Office下出现横向滚动条不会自动定位的解决办法
- Access中国树控件 在win10电脑 节点行间距太小的解决办法
- EXCEL 2019 64位版(Office 2019 64位)早就支持64位Treeview 树控件 ListView列表等64位MSCOMMCTL.OCX控件下载
- VBA或VB6调用WebService(直接Post方式)并解析返回的XML
Access ADP Sql Server等
- 早期PB程序连接Sqlserver出现错误
- MMC 不能打开文件C:/Program Files/Microsoft SQL Server/80/Tools/Binn/SQL Server Enterprise Manager.MSC 可能是由于文件不存在,不是一个MMC控制台,或者用后来的MMC版
- sql server连接不了的解决办法
- localhost与127.0.0.1区别
- Roych的浅谈数据库开发系列(Sql Server)
- sqlserver 自动备份对备份目录没有存取权限的解决办法
- 安装Sql server 2005 express 和SQLServer2005 Express版企业管理器 SQLServer2005_SSMSEE
文章分类
联系我们
联系人: | 王先生 |
---|---|
Email: | 18449932@qq.com |
QQ: | 18449932 |
微博: | officecn01 |