ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 56242|回复: 180

VBProject:代码操作代码之常用语句

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2006-10-2 20:55 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:Project协同

一、增加模块

1.增加一个模块,命名为我的模块

  ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule).Name = "我的模块"

  系统常量vbext_ct_StdModule=1

2.增加一个类模块,命名为我的类

  ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_ClassModule).Name = "我的类"

  vbext_ct_ClassModule=2

3.增加一个窗体,命名为我的窗体

  ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm).Name = "我的窗体"

  vbext_ct_MSForm=3

二、删除模块

1.删除模块1
  ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("模块1")

2.删除窗体UserForm1
  ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("UserForm1")

3.删除类模块类1
  ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("类1")

4.删除所有的窗体

Sub RmvForms()

  Dim vbCmp As VBComponent

  For Each vbCmp In ThisWorkbook.VBProject.VBComponents

    If vbCmp.Type = vbext_ct_MSForm Then ThisWorkbook.VBProject.VBComponents.Remove vbCmp

  Next vbCmp

End Sub

  相关:

  工作表和ThisWorkbook的模块类型为vbext_ct_Document=100

评分

参与人数 6鲜花 +11 收起 理由
zpy2 + 2 优秀作品
ravinn + 2 值得肯定
ybcxj2008 + 2 优秀作品
headroom2008 + 2 感谢帮助
引子玄 + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2006-10-2 20:57 | 显示全部楼层

三、增加代码

1.在模块1中插入代码

如果需要在Sheet1Thisworkbook、或Userform1中操作,用只需将下面的模块1换成相应的名称即可。

方法1:

在模块的开始增加代码,增加的代码放在公共声明option,全局变量等后面。

Sub AddCode1()

 ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.AddFromString _

   "sub aTest()" & Chr(10) & _

   "msgbox ""Hello""" & Chr(10) & _

   "end sub"

End Sub

方法2:

在模块指定行处增加代码,原代码后移。增加代码不理会和判断插入处代码的内容。当指定行大于最后一行行号时,在最后一行的后面插入。

Sub AddCode2()

  With ThisWorkbook.VBProject.VBComponents("模块1").CodeModule

    .InsertLines 1, "sub aTest()"

    .InsertLines 2, "msgbox ""Hello"""

    .InsertLines 3, "end sub"

  End With

End Sub

 

相关语句:

(1)模块1中代码总行数:

ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.CountOfLines

(2)模块1中代码公共声明部分的行数:

ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.CountOfDeclarationLines

[此贴子已经被作者于2006-10-2 21:05:48编辑过]

TA的精华主题

TA的得分主题

 楼主| 发表于 2006-10-2 20:58 | 显示全部楼层

(3)显示模块1中第1行起的3行代码内容:

Sub ShowCodes()

  Dim s$

  s = ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.Lines(1, 3)

  Debug.Print s

End Sub

(4)过程aTest的起始行数:

ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ProcBodyLine("aTest", vbext_pk_Proc)

ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ProcStartLine("aTest", 0)

系统常量vbext_pk_Proc=0

二者的区别是ProcBodyLine返回sub aTest或Function aTest所在的行号,如果sub前面有空行,ProcStartLine返回空行的行号。

(5)过程aTest的总行数:

ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ProcCountLines("aTest", vbext_pk_Proc)

2.建立事件过程

建立事件过程除了使用上面的代码如下面的AddEventsCode1外,还可以使用CreateEventProc方法,如AddEventsCode2所示。

一般方法:

Sub AddEventsCode1()

  ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString _

    "Private Sub Workbook_Open()" & Chr(13) & _

    "MsgBox ""Hello""" & Chr(13) & _

    "End Sub"

End Sub

CreateEventProc方法:

Sub AddEventsCode2()

  Dim i%

  With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule

    i = .CreateEventProc("SelectionChange", "Worksheet") + 1

    .InsertLines i, "Msgbox ""Hello"""

  End With

End Sub

上面CreateEventProc的两个参数建立的事件过程为Worksheet_SelectionChange,分别是下划线两边的内容。

[此贴子已经被作者于2006-10-2 21:10:37编辑过]

TA的精华主题

TA的得分主题

 楼主| 发表于 2006-10-2 20:59 | 显示全部楼层

相关:
测试是否存在SelectionChange事件
下面函数测试模块modulname是否存在过程subname,如果存在,则返回起始行号,否则返回0。
debug.print hassub("Worksheet_SelectionChange","Sheet1")
Function HasSub(ByVal subname As String, ByVal modulname As String) As Long
  On Error Resume Next
  Dim i&
  i = ThisWorkbook.VBProject.VBComponents(modulname).CodeModule.ProcBodyLine(subname, 0)
  If Err.Number = 35 Then
    Err.Clear
    HasSub = 0
  Else
    HasSub = i
  End If
End Function
如果存在,则返回起始行号,否则返回0。
四、删除代码
1.删除Sheet1中第2行起的三行代码:
如果只删除1行代码,第二个参数可省略。
Sub DelCodes()
 ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule.DeleteLines 2, 3
End Sub
2.删除“模块1”的所有代码:
Sub DelCodes()
 With ThisWorkbook.VBProject.VBComponents("模块1").CodeModule
   .DeleteLines 1, .CountOfLines
 End With
End Sub
3.删除过程aTest:
Sub DelCodes()
  With ThisWorkbook.VBProject.VBComponents("模块1").CodeModule
   .DeleteLines .ProcStartLine("aTest", 0), .ProcCountLines("aTest", 0)
  End With
End Sub
4.将“模块1”的第5行代码替换为“x=3”
 ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ReplaceLine 5, "x=3"

[此贴子已经被作者于2006-12-14 19:32:29编辑过]

TA的精华主题

TA的得分主题

 楼主| 发表于 2006-10-2 21:00 | 显示全部楼层

五、引用项目

1.增加引用

  ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\System32\asctrls.ocx"

2.取消引用

  ThisWorkbook.VBProject.References.Remove ThisWorkbook.VBProject.References("ASControls")

这里ASControls是引用的名字,即后面的rf.Name。

3.显示当前所有引用

Sub ShowRefs()

  Dim rf As VBIDE.Reference

  For Each rf In ThisWorkbook.VBProject.References

    Debug.Print rf.Name, rf.FullPath

  Next

End Sub

六、信任及密码

上面所有操作都基于这样的前题:

(1)EXCEL已设置:

工具(T)-宏(M)-安全性(M)-可靠发行商(T)-勾选了“信任对于VB项目的访问(V)”

(2)工程没有设置密码

如果不能满足它们中的任何一个,代码运行就会出错。因为微软不希望我们对VBProject进行操作,我们无从知道这种操作的直接方法被藏到了什么地方。幸运的是,微软在关起正门的同时,还是为我们留了一道门:SendKeys。借助于这道后门和“错误陷阱”,我们仍可以完成我们所要做的事。

下面给出绕开这两道门的示意代码,如果你要运行它们,请记得切回EXCEL主界面,而不是在VBE中直接运行。

[此贴子已经被作者于2006-10-2 21:17:09编辑过]

TA的精华主题

TA的得分主题

 楼主| 发表于 2006-10-2 21:11 | 显示全部楼层

1.信任对于VB项目的访问

Sub SetAllowableVbe()

  On Error Resume Next

  Dim Chgset As Boolean

  '陷阱测试,VBProject.Protection在这儿并无实际的意义

  Debug.Print ThisWorkbook.VBProject.Protection

  If Err.Number = 1004 Then

    Err.Clear

    Application.SendKeys "%TMS%T%V{ENTER}"

    Chgset = True

    DoEvents

  End If

  '要执行的操作....

  '.....

  '操作完成后还原操作前的状态

  If Chgset Then Application.SendKeys "%TMS%T%V{ENTER}"

End Sub

2.操作密码工程

Sub AllowPass()

  Dim pw$

  pw = "Password"

  If ThisWorkbook.VBProject.Protection = vbext_pp_locked Then

    Application.VBE.CommandBars(1).Controls("工具(T)").Controls("VBAProject 属性(&E)...").Execute

    Application.SendKeys pw & "{ENTER}{ENTER}"

    DoEvents

  End If

  '要执行的操作….

  '.....

End Sub

Protection属性返回工程的受保护状态,vbext_pp_locked(1)为受保护,vbext_pp_none(0)表示没有保护。

 

 

[参考]

网络相关文章。

[此贴子已经被作者于2006-10-14 0:09:11编辑过]

评分

参与人数 2鲜花 +4 收起 理由
ahh0511 + 2 优秀作品
liushenglly + 2 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2006-10-2 21:19 | 显示全部楼层
给自己献朵花,真不容易.[em23]
发贴什么时候开始有限制的?

TA的精华主题

TA的得分主题

发表于 2006-10-2 21:48 | 显示全部楼层

献花的同时,收藏此文章!

[em23][em23][em23][em23][em23][em23][em23][em23]

TA的精华主题

TA的得分主题

发表于 2006-10-2 23:06 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2006-10-3 01:25 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-10-22 00:11 , Processed in 0.090126 second(s), 14 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

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