DLL封装及引用

XZ19860527

题外话 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个单元格...字典未计算上限加一的原因

XZ19860527

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中封装的代码

XZ19860527

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 编辑 ]

XZ19860527

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

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

XZ19860527

怎么没人讨论呢?
上传一个工作簿内多表汇总的列子.通过封装,成功的把每月汇总需要的工具隐藏起来.

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

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

附件含工程源码.

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

XZ19860527

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

复制代码

加上判断是否注册用户的列子

yuioplkjh

学习学习，今天又学了一招

tonychris

但世上没有永久的宴席,和公司总有分手的的时候,离别方知世情冷暖,面对自己的心血被公司免费占用,岂不痛心疾首?

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

maqiuhua

学习下，是不是我的电脑有问题还是怎么了，里面有的链接也打不开

静静心

有没有最简单的教程？
比如我制作了一些函数，如何封装成DLL？？