ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 46568|回复: 75

[分享] DLL封装及引用

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2011-8-7 14:36 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 XZ19860527 于 2011-8-14 21:17 编辑

题外话 http://club.excelhome.net/thread-749866-1-1.html
看了everee 兄为方便自己工作开发VBA工具是否属于公司的讨论深有感触,我们为了提高工作效率没日没夜的钻研办公技巧,虽然得到了领导的赞同和自身的提高,但世上没有永久的宴席,和公司总有分手的的时候,离别方知世情冷暖,面对自己的心血被公司免费占用,岂不痛心疾首?
回首EHOME学习两年,虽然算不上多大进步,至少简单的工具还是做了不少,为了保护自己权益,于是觉得有必要开始学习封装技术,或许不需要多精通,只要能把主要,核心的代码隐藏起来就可以了!,或许加上试用时间限制或者注册码就更完美.

从今天开始学DLL封装,与家人同勉! 以下教程转自http://blog.sina.com.cn/s/blog_55ee0b090100hcx6.html

在vb中,修改“工程”名称和“类模块”名称为需要的名称。本例中,工程修改为TestDLL,类模块修改为Test。
引用Microsoft Office 11.0 Object Library和Microsoft Excel 11.0 Object Library。
Sub mySub(EApp As Excel.Application, r As Long, c As Integer)
    Dim wb As Excel.Workbook, sh As Excel.Worksheet
    Set wb = EApp.ThisWorkbook
    Set sh = wb.ActiveSheet
  sh.Cells(r,c)="这是测试文本"
  '其他的代码
End Sub

在Excel中,在VBA中要引用刚才生成的TestDll.dll。
新建一个模块,在其中定义一个类变量T:
Public T As New TestDll.Test

Sub AAA()
   On Error Resume Next
   T.mySub Application, 3, 7
End Sub

至此,可以在Excel中执行宏AAA,并会在(3,7)单元格得到字符串"这是测试文本"。

'====加载与卸载引用的语句========================================================
shell "Regsvr32 /u /s " & Chr(34) & ThisWorkBook.path & "\test.dll"& Chr(34) '卸载引用的Dll
shell "Regsvr32 /s " & Chr(34) & ThisWorkBook.path & "\test.dll"& Chr(34) '加载引用的Dll
/s 表示不出现对话框

'=========================================================
怎样去掉"工程-引用"中曾经引用的自制的DLL历史记录?

在注册表的 HKEY_CLASSES_ROOT\TypeLib\ 分支中查找“数据”等于“Test”(需要删掉的历史记录),然后会找到一个键值,该键值的数据等于“Test”,看看这个分支下面的数据,是否包含你 DLL的位置等信息,如果确定。则删除这个键值所在HKEY_CLASSES_ROOT\TypeLib\下的{xxxxxxxx-xxxx-xxxx- xxxx-xxxxxxxxxxxx}分支。(xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx根据你的实际情况是不同的16 进制)

必要条件: 1 首先要安装VB6.0(精简版也可以,只有6M)
                2 VB引用EXCEL,EXCEL引用DLL
                3 恒心,反复调试
相信大家会收获良多!附件中DLL引用的是EXCEL2007(EXCEL12.0),如2003版出错请自己编译!
附件尚未完全成功,!提取10个单元格不重复值,结果代码只执行到9个单元格...字典未计算上限加一的原因

桌面.rar

13.56 KB, 下载次数: 1114

评分

2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2011-8-7 15:02 | 显示全部楼层
  1. Sub mySub(EApp As Excel.Application, r As Long, c As Integer)
  2.     Dim wb As Excel.Workbook, sh As Excel.Worksheet
  3.     Set wb = EApp.ThisWorkbook
  4.     Set sh = wb.ActiveSheet
  5.     Dim d, k
  6.     Set d = CreateObject("Scripting.Dictionary")
  7.     For i = 1 To 10
  8.         d(sh.Cells(i, 1)) = ""
  9.     Next i
  10.     k = d.KEYS
  11.     sh.Cells(r, c) = "这是测试文本"
  12.     sh.Cells(r, c).Offset(0, 1).Resize(UBound(k), 1) = Application.Transpose(k)
  13.     '其他的代码
  14. End Sub
复制代码
VB中封装的代码

点评

能否顺便把图片也发上来呢?这样更便于我们这些小鸟学习啊  发表于 2011-8-14 21:45

TA的精华主题

TA的得分主题

 楼主| 发表于 2011-8-7 17:33 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
  1. Sub HZ(EApp As Excel.Application, wb As Excel.Workbook)
  2. 'Dim wb As Excel.Workbook
  3. Dim sh As Excel.Worksheet
  4. Dim PATH As String
  5. Dim dirr
  6. PATH = EApp.ThisWorkbook.PATH
  7. dirr = Dir(PATH & "/*.xls")
  8.    Do While dirr <> ""
  9.       If dirr <> EApp.ThisWorkbook.Name Then
  10.           On Error GoTo oo
  11.           Set wb = EApp.Workbooks.Open(PATH & "" & dirr)
  12.           wb.Sheets("经营分析表").Copy EApp.ThisWorkbook.Sheets(2)
  13.           EApp.ThisWorkbook.ActiveSheet.Name = Mid(wb.Sheets("经营分析表").[a2], 1, 3)
  14.           i = i + 1
  15.           wb.Close False
  16.       End If
  17.       dirr = Dir
  18.    Loop
  19.    Exit Sub
  20. oo:
  21.     MsgBox "Error on:" & Left(dirr, Len(dirr) - 4)
  22.     EApp.ThisWorkbook.Sheet2.Range("a65536").End(xlUp).Offset(1, 0) = dirr '这句代码不成功,尚在研究之中
  23.     Resume Next
  24. End Sub
复制代码
代码作用:汇总同一工作薄路径下所有工作薄中名为"经营分析"的表格
代码失败之处: 1 错误表格处理语句会中断
             2 excel引用不加错误处理语句的话会提示 "类型不匹配",但处理过程确实是完成了的.
研究之中...

跟新了附件 原来上传的时候没加上源码

[ 本帖最后由 XZ19860527 于 2011-8-8 12:26 编辑 ]

2011年06月连锁店综合月报表.rar

40.54 KB, 下载次数: 451

TA的精华主题

TA的得分主题

 楼主| 发表于 2011-8-8 07:51 | 显示全部楼层
目前的体会 1 VB封装和VBA大致一样,但封装必须要逐句将EXCEL对象前面加上VB引用对象模式 如 表示工作表相对路径 VBA里面是thisworkbook.path VB里面应该是 EXAPP.thisworkbook.path.刚开始学的时候可以使用绝对路径来练习;
   2 因为VB和VBA的相似性,新手也比较上手,自己动手做几次应该就有一个大致的了解了.要注意变量的声明和EXCEL对象的引用;多看一些列子,然后跟着教程重做几遍

以下是灰袍法师老师的专贴:
http://club.excelhome.net/viewth ... ;page=1#pid5098181.

TA的精华主题

TA的得分主题

 楼主| 发表于 2011-8-8 16:01 | 显示全部楼层
怎么没人讨论呢?
上传一个工作簿内多表汇总的列子.通过封装,成功的把每月汇总需要的工具隐藏起来.

虽然没有加上日期判断,但也能保证使用者无法通过修改部分代码来适应新的表格的功能,这就限制了他人使用.
当然,公司如不需要跟新格式的话是可以一直使用的,所以为了保证自己权益,最好还是做一个日期判断或者注册码,这是我下一步学习的目标.

毕竟,数据汇总工具只是为了提高效率,我们不授权别人使用,人家还是可以一步一步汇总.
就我这个示列来说,成功的将1天半-两天地工作量压缩到了10分钟.

附件含工程源码.

[ 本帖最后由 XZ19860527 于 2011-8-8 16:05 编辑 ]

DLL.rar

56.62 KB, 下载次数: 763

TA的精华主题

TA的得分主题

 楼主| 发表于 2011-8-14 19:03 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
  1. Sub registerYS()
  2. '******************
  3. '判断注册表某个字段是否等于预设的值来确定是否注册用户
  4. '通过DLL封装来达到代码保密,限定未注册用户的使用次数
  5. '******************
  6. Dim cc$, tt$, XTIME
  7. cc = GetSetting(ThisWorkbook.Name, "mysection", "myyear") '取得注册表值
  8. tt = GetSetting(ThisWorkbook.Name, "mysection", "myTime") '取得注册表值
  9. XTIME = VBA.IIf(RC4(tt, "XIANGZHENG") = "", 0, RC4(tt, "XIANGZHENG"))
  10. If cc = "" Then
  11.    '判断是否首次使用,并设定注册表值
  12.    MsgBox "未注册用户!你有10次使用机会.", vbInformation, 64
  13.    SaveSetting ThisWorkbook.Name, "MySection", "MyYear", RC4("未注册", "XIANGZHENG") '设定注册表值
  14.    SaveSetting ThisWorkbook.Name, "MySection", "MyTime", RC4(1, "XIANGZHENG") '设定注册表值使用次数
  15. Else
  16.   '判断是否合法用户,因写入注册表值经过加密,用户无法自行修改解密
  17.    If cc <> StrToHex(RC4(GetHardDiskInfo(hdPrimaryMaster, hdOnlySN), "XIANGZHENG")) And RC4(cc, "XIANGZHENG") <> "未注册" Then
  18.         MsgBox "非法用户,系统退出!", vbExclamation: Exit Sub
  19.    End If
  20. End If
  21. '记录未注册用户使用次数,'判断未注册用户使用次数是否符合预期
  22. If RC4(cc, "XIANGZHENG") = "未注册" And XTIME < 10 Then
  23.    SaveSetting ThisWorkbook.Name, "MySection", "MyTime", RC4(XTIME + 1, "XIANGZHENG") '设定注册表值
  24.    MsgBox "你还可以试用:" & 9 - XTIME & "次", vbInformation
  25. Else
  26.    If RC4(cc, "XIANGZHENG") = "未注册" And XTIME >= 10 Then MsgBox "试用次数耗尽!无权操作本系统!", vbInformation: Exit Sub
  27. End If
  28. End Sub
复制代码
加上判断是否注册用户的列子

评分

2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2011-8-14 19:50 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
学习学习,今天又学了一招

TA的精华主题

TA的得分主题

发表于 2011-8-14 20:11 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
但世上没有永久的宴席,和公司总有分手的的时候,离别方知世情冷暖,面对自己的心血被公司免费占用,岂不痛心疾首?

呵呵,小心版权问题,合同和员工手册之类的东西,看看有没有写明员工的成果物属于公司这句话,
如果有的话,就不要明目张胆的弄注册之类的了,而应该隐蔽设置。

TA的精华主题

TA的得分主题

发表于 2011-8-14 20:48 | 显示全部楼层
学习下,是不是我的电脑有问题还是怎么了,里面有的链接也打不开

TA的精华主题

TA的得分主题

发表于 2011-8-14 20:52 | 显示全部楼层
有没有最简单的教程?
比如我制作了一些函数,如何封装成DLL??
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-11-15 06:42 , Processed in 0.047842 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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