设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
楼主: tanhong

VBA代码编程方法详解

[复制链接]
 楼主| 发表于 2010-10-31 15:07:32 | 显示全部楼层
本帖最后由 tanhong 于 2010-10-31 15:56 编辑

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


  1. '过程功能:删除指定行代码
  2. '输入参数:VBCompName (String字符串变量) 指定模块名
  3. '          StartLine  代码起始行
  4. '          LinesNum 代码行数,默认为一行
  5. Sub DelLinesCodes (VBCompName As String, StartLine As Long, _
  6.                 Optional LinesNum As Long = 1)   
  7. Dim VBProj      As VBProject
  8.     Dim VBComps    As VBComponents
  9.    
  10.    Set VBProj = VBE.ActiveVBProject
  11.    Set VBComps = VBProj.VBComponents
  12.    
  13.    VBComps(VBCompName).CodeModule.DeleteLines StartLine, LinesNum
  14. End Sub

  15. '******************************************************************
  16. '调用示例一:删除"模块1"中,第一行代码
  17. Call DelLinesCodes("模块1", 1)

  18. '******************************************************************
  19. '调用示例二:删除"模块1"中,从第一行到第十行代码
  20. CAll DelLinesCodes("模块1", 1, 10)
复制代码



6.11.2 删除指定过程所有代码

  1. '删除指定过程代码
  2. Public Sub DelProcCodes(VBCompName As String, VBProcName As String)
  3.    Dim VBProj       As VBProject
  4.    Dim VBComps     As VBComponents
  5.    Dim ProcKind      As vbext_ProcKind
  6.    
  7.    Set VBProj = VBE.ActiveVBProject
  8.    Set VBComps = VBProj.VBComponents
  9.    
  10.    With VBComps (VBCompName).CodeModule
  11.       .DeleteLines .ProcStartLine (VBProcName, ProcKind), _
  12.       .ProcCountLines (VBProcName, ProcKind)
  13.    End With
  14. End Sub

  15. '******************************************************************
  16. '调用示例:删除“模块1”中,“我的过程”所有代码
  17. Call  DelProcCodes ("模块1", "我的过程")
复制代码

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

  1. '删除指定模块中所有代码
  2. Public Sub DelVBCompCodes (ByVal VBCompName As String)
  3.    Dim VBProj    As VBProject
  4.    Dim VBComps  As VBComponents
  5.    
  6. '实例对象
  7.    Set VBProj = VBE.ActiveVBProject
  8.    Set VBComps = VBProj.VBComponents

  9.    '从代码模块中第一行到最后一行执行删除
  10.    VBComps(VBCompName).CodeModule.DeleteLines 1, _
  11.    VBComps(VBCompName).CodeModule.CountOfLines
  12. End Sub

  13. '******************************************************************
  14. '调用示例:删除“模块1”中所有代码
  15. Call  DelVBCompCodes ("模块1")
复制代码


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

  1. '过程功能:创建一个事件过程
  2. '输入参数:VBCompNameOrIndex(Variant)部件名或索引
  3. '          strEventProc(String)事件程序
  4. '          strEventObj(String)事件对象
  5. '          strInsertCode(String)事件中欲插入代码,默认为空
  6. Sub CreateEventProcCode (VBCompNameOrIndex As Variant, _
  7.                   strEventProc As String, _
  8.                   strEventObj As String, _
  9.                   Optional strInsertCode As String = "")
  10.    Dim VBProj     As VBProject
  11.    Dim VBComp    As VBComponent
  12.    Dim CodeMod    As CodeModule
  13.    Dim LineNum    As Long
  14.    
  15.    '实例化对象
  16.    Set VBProj = VBE.ActiveVBProject
  17.    Set VBComp = VBProj.VBComponents (VBCompNameOrIndex)
  18.    Set CodeMod = VBComp.CodeModule
  19.    
  20.    With CodeMod
  21.       LineNum = .CreateEventProc (strEventProc, strEventObj)
  22.       
  23. '是否为事件添了代码,如未添加则退出
  24.       If strInsertCode = vbNullString Then Exit Sub
  25.         '从事件代码之后插入新代码
  26.          LineNum = LineNum + 1
  27.         .InsertLines LineNum, strInsertCode
  28.    End With
  29. End Sub


  30. '************************************************
  31. '调用示例一:在窗体1中创建窗体加载事件,并加入代码
  32. Dim strProcCode  As String
  33. strProcCode = Space(4) & "Msgbox " & Chr(34) & "这是创建事件代码演示!"
  34. Call CreateEventProcCode("Form_窗体1", "Load", "Form", strProcCode)

  35. '************************************************
  36. '调用示例二:在窗体1中创建窗体打开事件,但不加入代码
  37. Call CreateEventProcCode("Form_窗体1", "Open", "Form")
复制代码
 楼主| 发表于 2010-10-31 15:08:02 | 显示全部楼层
本帖最后由 tanhong 于 2010-10-31 15:08 编辑

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

  1. '查找代码文本信息定义数据类型
  2. Public Type FindCodeInfo
  3. SLine As Long '起始行
  4. ELine As Long '结束行
  5. SCol As Long '起始列
  6. ECol As Long '结束列
  7. BooFound As Boolean '是否找到
  8. End Type

  9. '函数功能:搜索模块中代码文本自定义函数
  10. Function SearchCodeModule (ByVal VBCompNameOrIndex As Variant, _
  11. ByVal strFindCode As String) As FindCodeInfo
  12. Dim VBProj As VBProject
  13. Dim VBComp As VBComponent
  14. Dim CodeMod As CodeModule
  15. Dim Findcode As FindCodeInfo '自定义数据类型
  16. Dim SL As Long '起始行
  17. Dim SC As Long '起始列
  18. Dim EL As Long '结束行
  19. Dim EC As Long '结束列
  20. Dim Found As Boolean '查找是否存在

  21. '实例对象
  22. Set VBProj = VBE.ActiveVBProject
  23. Set VBComp = VBProj.VBComponents (VBCompNameOrIndex)
  24. Set CodeMod = VBComp.CodeModule

  25. With CodeMod
  26. '初始起始行列值
  27. SL = 1: SC = 1
  28. '初始结束行列值
  29. EL = .CountOfLines: EC = 255
  30. '开始查找
  31. Found = .Find (strFindCode, SL, SC, EL, EC, True, False, False)
  32. '如未找到继续查找
  33. Do Until Found = False
  34. With Findcode
  35. .SLine = SL: .SCol = SC
  36. .ELine = EL: .ECol = EC
  37. .BooFound = Found
  38. End With
  39. EL = .CountOfLines: SC = EC + 1: EC = 255
  40. Found = .Find (strFindCode, SL, SC, EL, EC, True, False, False)
  41. Loop
  42. End With
  43. '赋值输出
  44. SearchCodeModule = Findcode
  45. End Function


  46. '***************************************************
  47. '调用示例:查找模块"bas_ProcInfo"中"程序申明行"文本,并获取相关信息
  48. Dim FindInfo As FindCodeInfo '申明自定义数据类型
  49. '查找并赋值给自定义数据类型变量
  50. FindInfo = SearchCodeModule("bas_ProcInfo", "程序申明行")
  51. MsgBox "查找文件:" & FindInfo.BooFound & vbLf & _
  52. "起始行:" & FindInfo.SLine & vbLf & _
  53. "起始列:" & FindInfo.SCol & vbLf & _
  54. "结束行:" & FindInfo.ELine & vbLf & _
  55. "结束列:" & FindInfo.Ecol

复制代码



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

点击这里给我发消息

发表于 2010-10-31 15:40:17 | 显示全部楼层
已经很久没写addin了, 一看到老兄的代码,又勾起了兴趣.
 楼主| 发表于 2010-10-31 15:54:34 | 显示全部楼层
很期待老大的新作。
发表于 2010-10-31 18:48:04 | 显示全部楼层
强贴,顶起。
跟着版主学习。
发表于 2010-10-31 19:15:40 | 显示全部楼层
很不错的教程,谢谢江主!

点击这里给我发消息

发表于 2010-11-2 21:35:59 | 显示全部楼层
好贴子!
发表于 2010-11-8 20:05:48 | 显示全部楼层
好贴子
发表于 2010-12-14 23:19:31 | 显示全部楼层
高手,谢谢
发表于 2011-7-19 21:02:59 | 显示全部楼层
谢谢楼主提供学习资料
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-3-29 17:33 , Processed in 0.100985 second(s), 33 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表