ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
数据管理利器Foxtable2022下载 Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 Power Query数据清洗实战攻略 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 131|回复: 13

[讨论] vba中的类模块能不能替代thisworkbook里的事件?比如工作簿的open事件

[复制链接]

TA的精华主题

TA的得分主题

发表于 2021-11-25 17:42 | 显示全部楼层 |阅读模式
各位大佬!如题,vba中的类模块能不能替代thisworkbook里的事件?比如工作簿的open事件。

TA的精华主题

TA的得分主题

发表于 2021-11-25 17:55 | 显示全部楼层
Thisworkbook本来就是一个类模块

TA的精华主题

TA的得分主题

发表于 2021-11-25 18:27 | 显示全部楼层
类模块声明 public withevents thisBook as workbook
并编写对应事件Sub
声明  变量名= new 你创建的类模块名称
在加载项onLoad事件中 set 变量名.thisBook=Thisworkbook

TA的精华主题

TA的得分主题

发表于 2021-11-25 18:29 | 显示全部楼层
简七 发表于 2021-11-25 18:27
类模块声明 public withevents thisBook as workbook
并编写对应事件Sub
声明  变量名= new 你创建的类模 ...

这里应该是ActiveWorkBook
还要考虑工作簿切换
可以通过Application.workbookActivate事件来控制

TA的精华主题

TA的得分主题

发表于 2021-11-25 18:49 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2021-11-26 10:36 | 显示全部楼层
简七 发表于 2021-11-25 18:27
类模块声明 public withevents thisBook as workbook
并编写对应事件Sub
声明  变量名= new 你创建的类模 ...

不做加载项的话能实现吗?我的主要目的是通过代码把已导出的标准模块或窗体文件import到指定文件夹下的N个宏工作簿,而文档工程thisworkbook是用的删除重写的方式处理的,但实际测试中因为带有workbook.open事件,所以会报错,所以也想改成import的方式,但类模块不知道怎么正常触发事件

TA的精华主题

TA的得分主题

发表于 2021-11-26 11:19 | 显示全部楼层
矢口不言 发表于 2021-11-26 10:36
不做加载项的话能实现吗?我的主要目的是通过代码把已导出的标准模块或窗体文件import到指定文件夹下的N ...
  1. <blockquote>Sub a()
  2. Dim wb As Object
  3. Dim fname
  4. Dim sc As Object
  5. Set sc = CreateObject("scripting.dictionary")
  6. fname = Dir("d:\桌面\*.*")

  7. While fname <> ""
  8. If fname Like "*.cls" Or fname Like "*.bas" Or fname Like "*.frm" Then
  9. sc("d:\桌面" & fname) = ""
  10. End If
  11. fname = Dir
  12. Wend

  13. fname = Dir("d:\桌面\新建文件夹\*.xlsm")
  14. Dim importFile
  15. Application.ScreenUpdating = False
  16. Application.DisplayAlerts = False
  17. While fname <> ""
  18. Set wb = GetObject("d:\桌面\新建文件夹" & fname)
  19. For Each importFile In sc.keys
  20. wb.VBProject.VBComponents.Import (importFile)
  21. Next
  22. Windows(fname).Visible = True
  23. wb.Save

  24. wb.Close
  25. fname = Dir
  26. Wend
  27. Application.DisplayAlerts = True
  28. Application.ScreenUpdating = True

  29. End Sub
复制代码
文件目录可以用 Application.FileDialog(msoFileDialogFolderPicker) 获取

TA的精华主题

TA的得分主题

 楼主| 发表于 2021-11-26 11:26 | 显示全部楼层
矢口不言 发表于 2021-11-26 10:36
不做加载项的话能实现吗?我的主要目的是通过代码把已导出的标准模块或窗体文件import到指定文件夹下的N ...

突发奇想通过这个问题换了个思考方式解决了问题,类模块无法触发事件,也就是说可以当做普通文档存放在代码中,然后复制类代码写入到目标工作簿的文档工程中,只不过其中需要修改一下名称

TA的精华主题

TA的得分主题

发表于 2021-11-26 11:28 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2021-11-26 11:58 | 显示全部楼层
矢口不言 发表于 2021-11-26 11:26
突发奇想通过这个问题换了个思考方式解决了问题,类模块无法触发事件,也就是说可以当做普通文档存放在代 ...
  1. Sub a()
  2. Dim wb As Object
  3. Dim fname
  4. Dim sc As Object
  5. Dim ado As Object

  6. Set sc = CreateObject("scripting.dictionary")
  7. Set ado = CreateObject("adodb.stream")
  8. With ado
  9.      .Charset = "GB2312"
  10.      .Type = 2
  11. End With

  12. fname = Dir("d:\桌面\*.*")
  13. While fname <> ""
  14.     If fname Like "*.cls" Or fname Like "*.bas" Or fname Like "*.frm" Then
  15.         sc("d:\桌面" & fname) = ""
  16.     End If
  17. fname = Dir
  18. Wend
  19. fname = Dir("d:\桌面\新建文件夹\*.xlsm")
  20. Dim importFile
  21. Dim VBcomModule As Object
  22. Dim thisCode As String
  23. Application.ScreenUpdating = False
  24. Application.DisplayAlerts = False
  25. While fname <> ""
  26.     Set wb = GetObject("d:\桌面\新建文件夹" & fname)
  27.     For Each importFile In sc.keys
  28.         wb.VBProject.VBComponents.Import (importFile)
  29.         If importFile Like "*ThisWorkbook*" Then

  30.             With ado
  31.                 .Open
  32.                 .LoadFromFile importFile
  33.                 thisCode = .ReadText
  34.                 .Close
  35.             End With
  36.             Set VBcomModule = wb.VBProject.VBComponents.Item("ThisWorkbook").CodeModule
  37.             With VBcomModule
  38.                 .DeleteLines 1
  39.                 .InsertLines 2, thisCode
  40.             End With

  41.         End If
  42.     Next
  43.     Windows(fname).Visible = True
  44.     wb.Save
  45.    
  46.     wb.Close
  47. fname = Dir
  48. Wend
  49. Application.DisplayAlerts = True
  50. Application.ScreenUpdating = True
  51. End Sub
复制代码
搞定  thisworkbook的也可以写入了
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

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

GMT+8, 2021-12-4 03:39 , Processed in 0.062403 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2021 Wooffice Inc.

   

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

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

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