自动为窗体和报表添加代码并设置右键
时 间:2008-06-18 16:26:22
作 者: ID:563 城市:上海
摘 要: 如果你需要为很多窗体或报表重复添加一些代码, 或者需要设置是否允许显示右键菜单,显示什么菜单等,可使用下面的函数来自动编写代码,举一反三, 使用这种方法可实现很多丰富的功能
正 文:
'Public Function gfuncTransFrmAndRpt()
Dim ctr As Control
Dim strInfo(30, 7) As String
Dim iCnt As Integer
Dim i As Integer
Dim rpt As Report
dim frm as Form
Dim mdl As Module
Dim lngCount As Long, lngEndProc As Long, lngBodyLine As Long, lngStartLine As Long
Dim strProcName As String
Dim strNote As String
On Error Resume Next
Set rpt = Screen.ActiveReport
'If InStr(rpt.Tag, "..") > 0 Then Exit Function
Dim aoj As AccessObject
'设置所有窗体的右键菜单(或禁用),并自动添加初始化代码到窗体的打开事件中
For Each aoj In CurrentProject.AllForms
DoCmd.OpenForm aoj.Name, acDesign,,,,acHidden
Set frm = Forms(aoj.Name)
frm.ShortcutMenu =False
'frm.ShortcutMenu =True '如果要设置有右键菜单,请使用这两句
'frm.ShortcutMenuBar = "erpRpt"
Set mdl = rpt.Module
lngCount = 0
strProcName = "Form_Open"
lngCount = mdl.ProcCountLines(strProcName, vbext_pk_Proc)
If lngCount > 0 Then Err.Number = 0
If Err.Number <> 0 Then lngCount = 0
If lngCount = 0 Then
mdl.CreateEventProc "Open", "Form"
End If
lngCount = mdl.ProcCountLines(strProcName, vbext_pk_Proc)
lngStartLine = mdl.ProcStartLine(strProcName, vbext_pk_Proc)
lngBodyLine = mdl.ProcBodyLine(strProcName, vbext_pk_Proc)
lngEndProc = (lngBodyLine + lngCount - 1) - Abs(lngBodyLine - lngStartLine)
If Not mdl.Find("glInitRptStyle Me", 0, 0, mdl.CountOfLines, 300) Then
mdl.InsertLines lngBodyLine + 1, vbTab & "glInitFrmStyle Me '调用通用窗体初始化过程 "
End If
DoCmd.Close acForm, aoj.Name, acSaveYes
Next
'设置所有报表的右键菜单(或禁用),并自动添加初始化代码到报表的打开事件中
For Each aoj In CurrentProject.AllReports
DoCmd.OpenReport aoj.Name, acViewDesign
Set rpt = Reports(aoj.Name)
rpt.ShortcutMenuBar = "erpRpt"
Set mdl = rpt.Module
lngCount = 0
strProcName = "Report_Open"
lngCount = mdl.ProcCountLines(strProcName, vbext_pk_Proc)
If lngCount > 0 Then Err.Number = 0
If Err.Number <> 0 Then lngCount = 0
If lngCount = 0 Then
mdl.CreateEventProc "Open", "Report"
End If
lngCount = mdl.ProcCountLines(strProcName, vbext_pk_Proc)
lngStartLine = mdl.ProcStartLine(strProcName, vbext_pk_Proc)
lngBodyLine = mdl.ProcBodyLine(strProcName, vbext_pk_Proc)
lngEndProc = (lngBodyLine + lngCount - 1) - Abs(lngBodyLine - lngStartLine)
If Not mdl.Find("glInitRptStyle Me", 0, 0, mdl.CountOfLines, 300) Then
mdl.InsertLines lngBodyLine + 1, vbTab & "glInitRptStyle Me '调用通用报表初始化过程 "
End If
DoCmd.Close acReport, aoj.Name, acSaveYes
Next
End Function
Dim ctr As Control
Dim strInfo(30, 7) As String
Dim iCnt As Integer
Dim i As Integer
Dim rpt As Report
dim frm as Form
Dim mdl As Module
Dim lngCount As Long, lngEndProc As Long, lngBodyLine As Long, lngStartLine As Long
Dim strProcName As String
Dim strNote As String
On Error Resume Next
Set rpt = Screen.ActiveReport
'If InStr(rpt.Tag, "..") > 0 Then Exit Function
Dim aoj As AccessObject
'设置所有窗体的右键菜单(或禁用),并自动添加初始化代码到窗体的打开事件中
For Each aoj In CurrentProject.AllForms
DoCmd.OpenForm aoj.Name, acDesign,,,,acHidden
Set frm = Forms(aoj.Name)
frm.ShortcutMenu =False
'frm.ShortcutMenu =True '如果要设置有右键菜单,请使用这两句
'frm.ShortcutMenuBar = "erpRpt"
Set mdl = rpt.Module
lngCount = 0
strProcName = "Form_Open"
lngCount = mdl.ProcCountLines(strProcName, vbext_pk_Proc)
If lngCount > 0 Then Err.Number = 0
If Err.Number <> 0 Then lngCount = 0
If lngCount = 0 Then
mdl.CreateEventProc "Open", "Form"
End If
lngCount = mdl.ProcCountLines(strProcName, vbext_pk_Proc)
lngStartLine = mdl.ProcStartLine(strProcName, vbext_pk_Proc)
lngBodyLine = mdl.ProcBodyLine(strProcName, vbext_pk_Proc)
lngEndProc = (lngBodyLine + lngCount - 1) - Abs(lngBodyLine - lngStartLine)
If Not mdl.Find("glInitRptStyle Me", 0, 0, mdl.CountOfLines, 300) Then
mdl.InsertLines lngBodyLine + 1, vbTab & "glInitFrmStyle Me '调用通用窗体初始化过程 "
End If
DoCmd.Close acForm, aoj.Name, acSaveYes
Next
'设置所有报表的右键菜单(或禁用),并自动添加初始化代码到报表的打开事件中
For Each aoj In CurrentProject.AllReports
DoCmd.OpenReport aoj.Name, acViewDesign
Set rpt = Reports(aoj.Name)
rpt.ShortcutMenuBar = "erpRpt"
Set mdl = rpt.Module
lngCount = 0
strProcName = "Report_Open"
lngCount = mdl.ProcCountLines(strProcName, vbext_pk_Proc)
If lngCount > 0 Then Err.Number = 0
If Err.Number <> 0 Then lngCount = 0
If lngCount = 0 Then
mdl.CreateEventProc "Open", "Report"
End If
lngCount = mdl.ProcCountLines(strProcName, vbext_pk_Proc)
lngStartLine = mdl.ProcStartLine(strProcName, vbext_pk_Proc)
lngBodyLine = mdl.ProcBodyLine(strProcName, vbext_pk_Proc)
lngEndProc = (lngBodyLine + lngCount - 1) - Abs(lngBodyLine - lngStartLine)
If Not mdl.Find("glInitRptStyle Me", 0, 0, mdl.CountOfLines, 300) Then
mdl.InsertLines lngBodyLine + 1, vbTab & "glInitRptStyle Me '调用通用报表初始化过程 "
End If
DoCmd.Close acReport, aoj.Name, acSaveYes
Next
End Function
Access软件网QQ交流群 (群号:54525238) Access源码网店
常见问答:
技术分类:
源码示例
- 【源码QQ群号19834647...(12.17)
- 合并列数据到一个文本框的示例;...(05.06)
- 通过命令按钮让Access列表...(04.24)
- 统计当月之前(不含当月)的记录...(03.11)
- 【Access Inputbo...(03.03)
- 按回车键后光标移动到下一条记录...(02.12)
- 【Access Dsum示例】...(02.07)
- Access对子窗体的数据进行...(02.05)
- 【Access高效办公】上月累...(01.09)
- 【Access高效办公】上月累...(01.06)

学习心得
最新文章
- 仓库管理实战课程(18)-设置日期...(05.19)
- 仓库管理实战课程(17)-库存明细...(05.13)
- 【Access高效办公】条件格式设...(05.12)
- 仓库管理实战课程(16)-联合查询...(05.07)
- 合并列数据到一个文本框的示例;输出...(05.06)
- 仓库管理实战课程(15)-月度库存...(04.30)
- Access选择打印机、横纵向、纸...(04.29)
- 仓库管理实战课程(14)-出库功能...(04.26)
- 通过命令按钮让Access列表框指...(04.24)
- 仓库管理实战课程(13)-入库功能...(04.21)