ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

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

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2009-3-18 00:19 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖已被收录到知识树中,索引项:封装
good!!!sssss

TA的精华主题

TA的得分主题

发表于 2009-3-20 16:50 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

不行

看看下面常用的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


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

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

TA的精华主题

TA的得分主题

发表于 2009-3-20 16:53 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2009-3-21 20:41 | 显示全部楼层

回复 47楼 yeqinxue 的帖子

这样是可以的:
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

TA的精华主题

TA的得分主题

发表于 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如何写呀?如何传递呢?

TA的精华主题

TA的得分主题

 楼主| 发表于 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 编辑 ]

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-3-28 22:45 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

回复 43楼 boleyndsd 的帖子

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

TA的精华主题

TA的得分主题

发表于 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\ 这个分支下面的数据?

TA的精华主题

TA的得分主题

 楼主| 发表于 2009-4-2 13:34 | 显示全部楼层
谢谢解决问题,又学到一个知识,
就是搜索注册表时,如何做到只搜索TypeLib\ 这个分支下面的数据?


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

TA的精华主题

TA的得分主题

发表于 2009-4-2 15:49 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-11-15 02:05 , Processed in 0.038076 second(s), 8 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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