VBA封装为Dll的例子、方法与总结【逐步完善中...】

lizi8000 · 发表于 2009-3-18 00:19

good!!!sssss

yeqinxue · 发表于 2009-3-20 16:50

看看下面常用的VBA界面处理代码，封装为Dll时应该如何改代码？

'需要封装的VBA代码
Sub 恢复系统界面()
On Error Resume Next
With Application
      .Caption = "版权所有:GoodFortune From www.ExcelHome.net"
      .CommandBars("Worksheet Menu Bar").Enabled = True
      .CommandBars("Toolbar List").Enabled = True
      .CommandBars("Standard").Visible = True
      .CommandBars("Formatting").Visible = True
      .DisplayFormulaBar = True
End With
With ActiveWindow
      .DisplayGridlines = True
      .DisplayHeadings = True
      .DisplayHorizontalScrollBar = True
      .DisplayVerticalScrollBar = True
      .DisplayWorkbookTabs = True
End With
End Sub
Sub 隐藏系统界面()
On Error Resume Next
With Application
      .CommandBars("Worksheet Menu Bar").Enabled = False
      .CommandBars("Toolbar List").Enabled = False
      .CommandBars("Standard").Visible = False
      .CommandBars("Formatting").Visible = False
      .DisplayFormulaBar = False
End With
With ActiveWindow
      .DisplayGridlines = True
      .DisplayHeadings = False
      .DisplayHorizontalScrollBar = False
      .DisplayVerticalScrollBar = False
      .DisplayWorkbookTabs = False
End With
End Sub

首先，分析一下，上面的VBA代码中有几个需要传递的变量（或者先分析“对象”），一个是Application，一个是ActiveWindow，其中ActiveWindow是Application的下一级对象，因此，按第2条原则，从最上一层开始，完整形式为Application.ActiveWindow，因此上面的代码可以改成如下的形式，用一个变量传递就可以了。

'封装为Dll的代码
Sub 恢复系统界面(oExcel as Excel.Application)
On Error Resume Next
With oExcel
      .Caption = "版权所有:GoodFortune From www.ExcelHome.net"
      .CommandBars("Worksheet Menu Bar").Enabled = True
      .CommandBars("Toolbar List").Enabled = True
      .CommandBars("Standard").Visible = True
      .CommandBars("Formatting").Visible = True
      .DisplayFormulaBar = True
End With
With oExcel.ActiveWindow
      .DisplayGridlines = True
      .DisplayHeadings = True
      .DisplayHorizontalScrollBar = True
      .DisplayVerticalScrollBar = True
      .DisplayWorkbookTabs = True
End With
End Sub
Sub 隐藏系统界面(oExcel as Excel.Application)
On Error Resume Next
With oExcel
      .CommandBars("Worksheet Menu Bar").Enabled = False
      .CommandBars("Toolbar List").Enabled = False
      .CommandBars("Standard").Visible = False
      .CommandBars("Formatting").Visible = False
      .DisplayFormulaBar = False
End With
With oExcel.ActiveWindow
      .DisplayGridlines = True
      .DisplayHeadings = False
      .DisplayHorizontalScrollBar = False
      .DisplayVerticalScrollBar = False
      .DisplayWorkbookTabs = False
End With
End Sub

由上可见，封装中需要修改的是将对象变量换成从根一级开始的完整形式，其他部分则不需要修改。

上面的例子是我学习中的经验总结，拿出来分享，虽然写的不好，但却是自己一步一步琢磨的，希望能抛砖引玉，请朋友们多指点

yeqinxue · 发表于 2009-3-20 16:53

楼上VBA代码运行没反映

zyg365 · 发表于 2009-3-21 20:41

这样是可以的：
Sub 恢复系统界面()
Dim xlapp As Object

Set xlapp = GetObject(, "Excel.Application") '取得Excel实例
On Error Resume Next
With xlapp
      .Caption = "版权所有：宏通VBA软件工作室 www.VBAsoft.Com"
      .CommandBars("Worksheet Menu Bar").Enabled = True
      .CommandBars("Toolbar List").Enabled = True
      .CommandBars("Standard").Visible = True
      .CommandBars("Formatting").Visible = True
      .DisplayFormulaBar = True
End With
With xlapp.ActiveWindow
      .DisplayGridlines = True
      .DisplayHeadings = True
      .DisplayHorizontalScrollBar = True
      .DisplayVerticalScrollBar = True
      .DisplayWorkbookTabs = True
End With
End Sub
Sub 隐藏系统界面()
Dim xlapp As Object

  Set xlapp = GetObject(, "Excel.Application") '取得Excel实例
On Error Resume Next
With xlapp
      .Caption = "版权所有：宏通VBA软件工作室 www.VBAsoft.Com"
      .CommandBars("Worksheet Menu Bar").Enabled = False
      .CommandBars("Toolbar List").Enabled = False
      .CommandBars("Standard").Visible = False
      .CommandBars("Formatting").Visible = False
      .DisplayFormulaBar = False
End With
With xlapp.ActiveWindow
      .DisplayGridlines = True
      .DisplayHeadings = False
      .DisplayHorizontalScrollBar = False
      .DisplayVerticalScrollBar = False
      .DisplayWorkbookTabs = False
End With
End Sub

sblisb · 发表于 2009-3-28 16:24

If Target.Column = 2 Then


   Target.Offset(, 2).FormulaR1C1 = "=IF(RC[-1]>0,ROUND(0.3*RC[-3]^1.9*RC[13]^5*,4),"""")"
MsgBox "写公式"

End If
这段转为dll如何写呀？如何传递呢？

GoodFortune · 发表于 2009-3-28 22:40

原帖由 anjing572 于 2008-10-14 18:59 发表
楼主应该在作几个例子吗

感谢朋友们的支持！继续期待朋友们的关注，也欢迎共同交流和进行VBA开发！
下面的例子是：封装工作表事件 Worksheet_SelectionChange 下的代码。

'工作表事件代码为:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Long, c As Integer

r = Target.Row
c = Target.Column

If c = 2 Then
      Cells(r, c).Offset(, 2).FormulaR1C1 = "=IF(RC[-1]>0,ROUND(0.00005806186*RC[-3]^1.9553351*RC[13]^0.89403304*RC[-2],4),"""")"
      MsgBox "写公式"
End If
End Sub

封装为DLL的源代码，封装成 Test.dll （其中工程名为Test,类名为 T）：
Sub mySheet_SelectionChange(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

If c = 2 Then
      sh.Cells(r, c).Offset(, 2).FormulaR1C1 = "=IF(RC[-1]>0,ROUND(0.00005806186*RC[-3]^1.9553351*RC[13]^0.89403304*RC[-2],4),"""")"
      MsgBox "写公式"
End If
End Sub
请比较以上两个代码的区别和联系。

调用时的代码：
标准模块中定义语句为：
Public T1 As New Test.T
sheet2中的工作表代码为：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Long, c As Integer
r = Target.Row
c = Target.Column

T1.mySheet_SelectionChange Application, r, c
End Sub

附加说明以下两个常用到的问题--------------------------------------------------------------
'====加载与卸载引用的语句========================================================
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进制）

[ 本帖最后由 GoodFortune 于 2009-3-28 22:45 编辑 ]

GoodFortune · 发表于 2009-3-28 22:45

抱歉，我也不知具体原因。

sblisb · 发表于 2009-3-29 15:15

原帖由 GoodFortune 于 2009-3-28 22:40 发表

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

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

谢谢解决问题，又学到一个知识，
就是搜索注册表时，如何做到只搜索TypeLib\ 这个分支下面的数据？

GoodFortune · 发表于 2009-4-2 13:34

谢谢解决问题，又学到一个知识，
就是搜索注册表时，如何做到只搜索TypeLib\ 这个分支下面的数据？

打开注册表后选中HKEY_CLASSES_ROOT\TypeLib\ 这个分支后在查找。

lbg555 · 发表于 2009-4-2 15:49

学习，学习

		自动登录	找回密码
密码			免费注册

VBA封装为Dll的例子、方法与总结【逐步完善中...】

不行

回复 47楼 yeqinxue 的帖子

评分

回复 43楼 boleyndsd 的帖子