VBA代码编程方法详解

tanhong · 发表于 2010-10-31 15:07:32

本帖最后由 tanhong 于 2010-10-31 15:56 编辑

6.11 代码模块中删除代码操作
6.11.1 删除指定行代码

'过程功能：删除指定行代码
'输入参数：VBCompName (String字符串变量) 指定模块名
' StartLine 代码起始行
' LinesNum 代码行数,默认为一行
Sub DelLinesCodes (VBCompName As String, StartLine As Long, _
Optional LinesNum As Long = 1)
Dim VBProj As VBProject
Dim VBComps As VBComponents
Set VBProj = VBE.ActiveVBProject
Set VBComps = VBProj.VBComponents
VBComps(VBCompName).CodeModule.DeleteLines StartLine, LinesNum
End Sub
'******************************************************************
'调用示例一：删除"模块1"中，第一行代码
Call DelLinesCodes("模块1", 1)
'******************************************************************
'调用示例二：删除"模块1"中，从第一行到第十行代码
CAll DelLinesCodes("模块1", 1, 10)

复制代码

6.11.2 删除指定过程所有代码

'删除指定过程代码
Public Sub DelProcCodes(VBCompName As String, VBProcName As String)
Dim VBProj As VBProject
Dim VBComps As VBComponents
Dim ProcKind As vbext_ProcKind
Set VBProj = VBE.ActiveVBProject
Set VBComps = VBProj.VBComponents
With VBComps (VBCompName).CodeModule
.DeleteLines .ProcStartLine (VBProcName, ProcKind), _
.ProcCountLines (VBProcName, ProcKind)
End With
End Sub
'******************************************************************
'调用示例：删除“模块1”中，“我的过程”所有代码
Call DelProcCodes ("模块1", "我的过程")

复制代码

6.11.3 删除部件或模块中所有代码

'删除指定模块中所有代码
Public Sub DelVBCompCodes (ByVal VBCompName As String)
Dim VBProj As VBProject
Dim VBComps As VBComponents
'实例对象
Set VBProj = VBE.ActiveVBProject
Set VBComps = VBProj.VBComponents
'从代码模块中第一行到最后一行执行删除
VBComps(VBCompName).CodeModule.DeleteLines 1, _
VBComps(VBCompName).CodeModule.CountOfLines
End Sub
'******************************************************************
'调用示例：删除“模块1”中所有代码
Call DelVBCompCodes ("模块1")

复制代码

6.12 添加事件过程代码操作
6.12.1 向指定部件对象添加事件

'过程功能：创建一个事件过程
'输入参数：VBCompNameOrIndex（Variant）部件名或索引
' strEventProc(String)事件程序
' strEventObj(String)事件对象
' strInsertCode(String)事件中欲插入代码,默认为空
Sub CreateEventProcCode (VBCompNameOrIndex As Variant, _
strEventProc As String, _
strEventObj As String, _
Optional strInsertCode As String = "")
Dim VBProj As VBProject
Dim VBComp As VBComponent
Dim CodeMod As CodeModule
Dim LineNum As Long
'实例化对象
Set VBProj = VBE.ActiveVBProject
Set VBComp = VBProj.VBComponents (VBCompNameOrIndex)
Set CodeMod = VBComp.CodeModule
With CodeMod
LineNum = .CreateEventProc (strEventProc, strEventObj)
'是否为事件添了代码，如未添加则退出
If strInsertCode = vbNullString Then Exit Sub
'从事件代码之后插入新代码
LineNum = LineNum + 1
.InsertLines LineNum, strInsertCode
End With
End Sub
'************************************************
'调用示例一：在窗体1中创建窗体加载事件,并加入代码
Dim strProcCode As String
strProcCode = Space(4) & "Msgbox " & Chr(34) & "这是创建事件代码演示！"
Call CreateEventProcCode("Form_窗体1", "Load", "Form", strProcCode)
'************************************************
'调用示例二：在窗体1中创建窗体打开事件,但不加入代码
Call CreateEventProcCode("Form_窗体1", "Open", "Form")

复制代码

tanhong · 发表于 2010-10-31 15:08:02

本帖最后由 tanhong 于 2010-10-31 15:08 编辑

6.13 查找代码获取相关信息
6.13.1查找代码文本获取起止行列与是否存在信息

'查找代码文本信息定义数据类型
Public Type FindCodeInfo
SLine As Long '起始行
ELine As Long '结束行
SCol As Long '起始列
ECol As Long '结束列
BooFound As Boolean '是否找到
End Type
'函数功能：搜索模块中代码文本自定义函数
Function SearchCodeModule (ByVal VBCompNameOrIndex As Variant, _
ByVal strFindCode As String) As FindCodeInfo
Dim VBProj As VBProject
Dim VBComp As VBComponent
Dim CodeMod As CodeModule
Dim Findcode As FindCodeInfo '自定义数据类型
Dim SL As Long '起始行
Dim SC As Long '起始列
Dim EL As Long '结束行
Dim EC As Long '结束列
Dim Found As Boolean '查找是否存在
'实例对象
Set VBProj = VBE.ActiveVBProject
Set VBComp = VBProj.VBComponents (VBCompNameOrIndex)
Set CodeMod = VBComp.CodeModule
With CodeMod
'初始起始行列值
SL = 1: SC = 1
'初始结束行列值
EL = .CountOfLines: EC = 255
'开始查找
Found = .Find (strFindCode, SL, SC, EL, EC, True, False, False)
'如未找到继续查找
Do Until Found = False
With Findcode
.SLine = SL: .SCol = SC
.ELine = EL: .ECol = EC
.BooFound = Found
End With
EL = .CountOfLines: SC = EC + 1: EC = 255
Found = .Find (strFindCode, SL, SC, EL, EC, True, False, False)
Loop
End With
'赋值输出
SearchCodeModule = Findcode
End Function
'***************************************************
'调用示例：查找模块"bas_ProcInfo"中"程序申明行"文本，并获取相关信息
Dim FindInfo As FindCodeInfo '申明自定义数据类型
'查找并赋值给自定义数据类型变量
FindInfo = SearchCodeModule("bas_ProcInfo", "程序申明行")
MsgBox "查找文件：" & FindInfo.BooFound & vbLf & _
"起始行：" & FindInfo.SLine & vbLf & _
"起始列：" & FindInfo.SCol & vbLf & _
"结束行：" & FindInfo.ELine & vbLf & _
"结束列：" & FindInfo.Ecol

复制代码

以上为本人研究关于VBA扩展类库在二次开发中的一点心得，现将其汇集成文与大家分享。上述文字中的代码并不能算最优化，也未囊括VBA扩展类库中对象所有属性、方法，但对于解决二次开发中可能遇到的大多数问题还是很有帮助的。
因为，成文较仓促，再则部分代码并未经过细致测试，不免有错漏之处，还请各位看文者帮助斧正，并告知本人，在此谢过。
因篇幅考虑，部分代码并未收入文中，大家可参看实例，文中“代码实例”可在本人专栏或Access Home论坛下载。

tmtony · 发表于 2010-10-31 15:40:17

已经很久没写addin了, 一看到老兄的代码,又勾起了兴趣.

tanhong · 发表于 2010-10-31 15:54:34

很期待老大的新作。

opelwang · 发表于 2010-10-31 18:48:04

强贴，顶起。
跟着版主学习。

li08hua · 发表于 2010-10-31 19:15:40

很不错的教程，谢谢江主！

zhuyiwen · 发表于 2010-11-2 21:35:59

好贴子！

sxb2007 · 发表于 2010-11-8 20:05:48

好贴子

yyxtj · 发表于 2010-12-14 23:19:31

高手，谢谢

noami · 发表于 2011-7-19 21:02:59

谢谢楼主提供学习资料

帐号		自动登录	找回密码
密码			注册

主题相关群

地区相关群[您还没设置居住地]

VBA代码编程方法详解

群介绍
主题无相 (随机显示版	同地区群块其他地区)

群介绍
Access免费培训群2 (792054000)