ExcelTip.Net留存知识帖 ---【注：附件之前被网盘供应商清空后，现已修复-现已修复-现已修复为本地下载！】
现在位置：首页 > E文精选 > Excel VBA > excel 与dll 链接

excel 与dll 链接

作者：绿色风 分类： 时间：2022-08-17 浏览：188
楼主
hlxz
本作品
是一个初学 excel 与dll 链接的
很好的范例

不过我的excel2009版本
将会在excel没有任何代码了



纪念我这个绝版 dll与excel 案例

和大家
分享部分代码
和范例下载

本案例主要是做菜单


当然案例中有
很多新功能
dll 内代码
  1. Private Sub Cd_小爪Excel2008()

  3. On Error Resume Next
  4. Dim EB
  5. Set EB = GetObject(, "Excel.application")
  6. Dim myNewBar As CommandBar
  7. Dim AAAA As New MZCK
  8. Dim HH_LL1 As String

  10. HH_LL1 = AAAA.HH_LL
  11. If HH_LL1 <> "YIPINMEI" Then MsgBox "您已超过本文件使用期限2!请联系作者！", 64, "系统提示": Set EB = Nothing: Exit Sub
  12. EB.CommandBars("小爪Excel2008").Delete
  13. EB.CommandBars("Cell").Reset
  14. Set myNewBar = EB.CommandBars.Add _

  16. (Name:="小爪Excel2008", Position:=msoBarTop, MenuBar:=True)
  17. EB.MenuBars("小爪Excel2008").Menus.Add Caption:="格式" '一级菜单
  18. EB.MenuBars("小爪Excel2008").Menus("格式").MenuItems.AddMenu Caption:="显示" '二级菜单
  19. EB.MenuBars("小爪Excel2008").Menus("格式").MenuItems("显示").MenuItems.Add Caption:="区域文本上标", OnAction:="An_上标" '三级菜单
  20. EB.MenuBars("小爪Excel2008").Menus("格式").MenuItems("显示").MenuItems.Add Caption:="区域文本取消上标", OnAction:="An_取消上标" '三级菜单
  21. EB.MenuBars("小爪Excel2008").Menus("格式").MenuItems("显示").MenuItems.Add Caption:="区域水平左垂直中", OnAction:="An_水平左垂直中" '三级菜单
  22. EB.MenuBars("小爪Excel2008").Menus("格式").MenuItems("显示").MenuItems.Add Caption:="区域水平中垂直中", OnAction:="An_水平中垂直中" '三级菜单
  23. EB.MenuBars("小爪Excel2008").Menus("格式").MenuItems("显示").MenuItems.Add Caption:="区域水平右垂直中", OnAction:="An_水平右垂直中" '三级菜单
  24. EB.MenuBars("小爪Excel2008").Menus("格式").MenuItems("显示").MenuItems.Add Caption:="区域粗框细表格线", OnAction:="An_粗框细格线" '三级菜单
  25. EB.MenuBars("小爪Excel2008").Menus("格式").MenuItems("显示").MenuItems.Add Caption:="区域细框细表格线", OnAction:="An_细框细格线" '三级菜单
  26. EB.MenuBars("小爪Excel2008").Menus("格式").MenuItems("显示").MenuItems.Add Caption:="区域文本自动换行", OnAction:="An_自动换行"
2楼
hlxz
  1. '-----------------------函数
  2. EB.MenuBars("小爪Excel2008").Menus.Add Caption:="函数" '一级菜单
  3. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems.AddMenu Caption:="文本函数" '二级菜单
  4. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("文本函数").MenuItems.Add Caption:="My提取公式", OnAction:="bzMy提取公式"
  5. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("文本函数").MenuItems.Add Caption:="My提取数字", OnAction:="bzMy提取数字"
  6. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("文本函数").MenuItems.Add Caption:="My提取汉字", OnAction:="bzMy提取汉字"
  7. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("文本函数").MenuItems.Add Caption:="My提取字母", OnAction:="bzMy提取字母"
  8. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("文本函数").MenuItems.Add Caption:="My提取本工作表名", OnAction:="bzMy提取本工作表名"
  9. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("文本函数").MenuItems.Add Caption:="My计算单元格字符出现次数", OnAction:="bzMy计算单元格字符出现次数"

  11. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("文本函数").MenuItems.Add Caption:="My提取文本内算式", OnAction:="bzMy提取文本内算式"
  12. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("文本函数").MenuItems.Add Caption:="My字符反向", OnAction:="bzMy字符反向"
  13. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("文本函数").MenuItems.Add Caption:="My分割字符", OnAction:="bzMy分割字符"

  15. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems.AddMenu Caption:="求和函数" '二级菜单
  16. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("求和函数").MenuItems.Add Caption:="My可见单元格求和", OnAction:="bzMy可见单元格求和"
  17. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("求和函数").MenuItems.Add Caption:="My同色字体求和", OnAction:="bzMy同色字体求和"
  18. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("求和函数").MenuItems.Add Caption:="My同背景色求和", OnAction:="bzMy同背景色求和"
3楼
hlxz
  1. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems.AddMenu Caption:="查找函数" '二级菜单
  2. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("查找函数").MenuItems.Add Caption:="My超级查找", OnAction:="bzMy超级查找"
  3. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("查找函数").MenuItems.Add Caption:="My超级分列", OnAction:="bzMy超级分列"
  4. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("查找函数").MenuItems.Add Caption:="My超级字符连接", OnAction:="bzMy超级字符连接"
  5. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("查找函数").MenuItems.Add Caption:="My不重复值", OnAction:="bzMy不重复值"
  6. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems.AddMenu Caption:="时间日期函数" '二级菜单
  7. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("时间日期函数").MenuItems.Add Caption:="My计算时差", OnAction:="bzMy计算时差"
  8. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("时间日期函数").MenuItems.Add Caption:="My宾馆住宿计算", OnAction:="bzMy宾馆住宿计算"
  9. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("时间日期函数").MenuItems.Add Caption:="My工作时和", OnAction:="bzMy计工作时和"
  10. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems.AddMenu Caption:="转换函数" '二级菜单
  11. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("转换函数").MenuItems.Add Caption:="My汉字转拼音", OnAction:="bzMy汉字转拼音"
  12. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("转换函数").MenuItems.Add Caption:="My数字转英文", OnAction:="bzMy数字转英文"
  13. EB.MenuBars("小爪Excel2008").Menus("函数").MenuItems("转换函数").MenuItems.Add Caption:="My人民币", OnAction:="bzMy人民币"
  14. '-----------------------操作
  15. EB.MenuBars("小爪Excel2008").Menus.Add Caption:="操作" '一级菜单
  16. EB.MenuBars("小爪Excel2008").Menus("操作").MenuItems.Add Caption:="操作按钮工具", OnAction:="Cd_操作按钮工具菜单"
  17. EB.MenuBars("小爪Excel2008").Menus("操作").MenuItems.Add Caption:="背景工具", OnAction:="Cd_背景窗体"
  18. EB.MenuBars("小爪Excel2008").Menus("操作").MenuItems.Add Caption:="提示输入工具", OnAction:="Cd_提示窗体"
  19. EB.MenuBars("小爪Excel2008").Menus("操作").MenuItems.Add Caption:="生成工资条", OnAction:="Cd_生成工资条"
  20. '-----------------------实用工具
  21. EB.MenuBars("小爪Excel2008").Menus.Add Caption:="实用工具" '一级菜单
  22. EB.MenuBars("小爪Excel2008").Menus("实用工具").MenuItems.Add Caption:="破解Excel工作表密码", OnAction:="Xz_解除工作表保护"
  23. EB.MenuBars("小爪Excel2008").Menus("实用工具").MenuItems.Add Caption:="破解Excelvba密码", OnAction:="Xz_破解VBA密码"
4楼
hlxz		 Call Cd_门窗开发程序
  1. EB.MenuBars("小爪Excel2008").Menus.Add Caption:="帮助" '一级菜单
  2. EB.MenuBars("小爪Excel2008").Menus("帮助").MenuItems.Add Caption:="工作表操作帮助", OnAction:="EX_工作表操作帮助"
  3. EB.MenuBars("小爪Excel2008").Menus("帮助").MenuItems.Add Caption:="ExcelVBA帮助", OnAction:="EX_ExcelVBA帮助"
  4. EB.MenuBars("小爪Excel2008").Menus("帮助").MenuItems.Add Caption:="Visual Basic帮助", OnAction:="EX_Visual_Basic帮助"
  5. EB.MenuBars("小爪Excel2008").Menus("帮助").MenuItems.Add Caption:="欢乐小爪社区", OnAction:="Cd_欢乐小爪社区"
  6. EB.MenuBars("小爪Excel2008").Menus("帮助").MenuItems.Add Caption:="欢乐小爪博客", OnAction:="Cd_欢乐小爪博客"
  7. EB.MenuBars("小爪Excel2008").Menus("帮助").MenuItems.Add Caption:="关于小爪Excel2008", OnAction:="Cd_关于小爪Excel2008"
  8. EB.MenuBars("小爪Excel2008").Menus("帮助").MenuItems.Add Caption:="注册本产品", OnAction:="Cd_注册窗体"
  9. '------------------------EXCEL2003菜单
  10. EB.MenuBars("小爪Excel2008").Menus.Add Caption:="EXCEL2003菜单" '一级菜单
  11. EB.MenuBars("小爪Excel2008").Menus("EXCEL2003菜单").MenuItems.Add Caption:="EXCEL2003菜单", OnAction:="Cd_EXCEL2003菜单"
  12. EB.MenuBars("小爪Excel2008").Activate
  13. End Sub
5楼
apolloh		 谢谢小爪，俺学习一下。

6楼
水星钓鱼		 MM发帖内容语言都与众不同,哈哈
7楼
wshcw		 谢谢分享,下载学习.
8楼
hlxz		 昨天的网速太不好，传了一个小时 才传了一点 现在继续，只是这么快就有人回复了
9楼
hlxz
  1. Private Sub Cd_EXCEL2003菜单()
  2.    On Error Resume Next
  3.    Dim EB
  4. Set EB = GetObject(, "Excel.application")
  5.   EB.ScreenUpdating = False
  6.   EB.CommandBars("欢乐小爪小工具").Delete
  7.   EB.MenuBars(xlWorksheet).Menus("小爪Excel2008").Delete
  8.   EB.CommandBars("cell").Reset
  9.   EB.CommandBars("Status Bar").Visible = True
  10.   EB.CommandBars(1).Visible = True
  11.   EB.CommandBars(3).Visible = True
  12.   EB.CommandBars(4).Visible = True
  13.   EB.CommandBars("Visual Basic").Visible = True
  14.   With EB.MenuBars(xlWorksheet).Menus.Add(Caption:="小爪Excel2008")
  15.       .MenuItems.Add Caption:="小爪Excel2008", OnAction:="Cd_小爪Excel2008"
  16.   End With
  17.   EB.ScreenUpdating = True
  18. End Sub
  19. '    *************************************************
  20. Private Sub Cd_欢乐小爪社区()
  21. Shell "explorer  http://huanlexiaozhua.5d6d.com"
  22. End Sub
  23. Private Sub Cd_欢乐小爪博客()
  24. Shell "explorer  http://hi.baidu.com/huanhuanxiaozhua/blog"
  25. End Sub
  26. Private Sub Cd_操作按钮工具菜单()
  27. On Error Resume Next
  28. Dim EB
  29. Dim 欢乐小爪小工具 As CommandBar
  30. Dim 子菜单 As CommandBarControl
  31. Dim HH_LL1 As String
  32. Dim AAAA As New MZCK
  33.   HH_LL1 = AAAA.HH_LL
  34. If HH_LL1 <> "*******" Then MsgBox "非法用户,限制使用": Exit Sub
  35. Set EB = GetObject(, "Excel.application")
  36.   EB.CommandBars("欢乐小爪小工具").Delete '删除已有菜单
  37. Set 欢乐小爪小工具 = EB.CommandBars.Add '添加新菜单
  38. With 欢乐小爪小工具
  39. .Visible = True '属性值（TRUE为显示）
  40. .Position = msoBarTop '将此菜单显示在顶部
  41. .Name = "欢乐小爪小工具"
  42. End With
  43. '=============================================
  44. Set 子菜单 = EB.CommandBars("欢乐小爪小工具").Controls.Add(Type:=msoControlButton) '添加新按钮
  45.     With 子菜单
  46.     .Caption = "最佳列宽"
  47.     .OnAction = "An_改善列宽"
  48.     .FaceId = 7008
  49.     .Visible = True
  50.     End With
  51. Set 子菜单 = EB.CommandBars("欢乐小爪小工具").Controls.Add(Type:=msoControlButton) '添加新按钮
  52.     With 子菜单
  53.     .Caption = "减少列宽"
  54.     .OnAction = "An_减少列宽"
  55.     .FaceId = 6282
  56.     .Visible = True
  57.     End With
  58. Set 子菜单 = EB.CommandBars("欢乐小爪小工具").Controls.Add(Type:=msoControlButton)  '添加新按钮
  59.     With 子菜单
  60.     .Caption = "增加列宽"
  61.     .OnAction = "An_增加列宽"
  62.     .FaceId = 6286
  63.     .Visible = True
  64.     End With
  65. Set 子菜单 = EB.CommandBars("欢乐小爪小工具").Controls.Add(Type:=msoControlButton)  '添加新按钮
  66.     With 子菜单
  67.     .Caption = "最佳行高"
  68.     .OnAction = "An_最佳行高"
  69.     .FaceId = 7009
  70.     .Visible = True
  71.     End With
  72. Set 子菜单 = EB.CommandBars("欢乐小爪小工具").Controls.Add(Type:=msoControlButton)  '添加新按钮
  73.     With 子菜单
  74.     .Caption = "增加行高"
  75.     .OnAction = "An_增加行高"
  76.     .FaceId = 6292
  77.     .Visible = True
  78.     End With
  79. Set 子菜单 = EB.CommandBars("欢乐小爪小工具").Controls.Add(Type:=msoControlButton)  '添加新按钮
  80.     With 子菜单
  81.     .Caption = "减少行高"
  82.     .OnAction = "An_减少行高"
  83.     .FaceId = 6288
  84.     .Visible = True
  85.     End With
  86. Set 子菜单 = EB.CommandBars("欢乐小爪小工具").Controls.Add(Type:=msoControlButton)  '添加新按钮
  87.     With 子菜单
  88.     .Caption = "√"
  89.     .OnAction = "An_打勾"
  90.     .FaceId = 1087
  91.     .Visible = True
  92.     End With
  93. Set 子菜单 = EB.CommandBars("欢乐小爪小工具").Controls.Add(Type:=msoControlButton)  '添加新按钮
  94.     With 子菜单
  95.     .Caption = "×"
  96.     .OnAction = "An_打叉"
  97.     .FaceId = 6503
  98.     .Visible = True
  99.     End With
  100.    
  101. End Sub
10楼
hlxz		 以上 是dll 部分代码 至于加密部分代码 我就不和大家分享了，


以下是 excel内 接口的代码
  1. Private Sub Workbook_Open()
  2. Application.Visible = True
  3.   On Error GoTo errline
  4.      Shell "Regsvr32 /s " & Chr(34) & ThisWorkbook.Path & "\ExcelCD.dll" & Chr(34), vbHide
  5.     Cd_EXCEL2003菜单
  6. errline:
  7. End Sub

  9. Private Sub Cd_小爪Excel2008()
  10. On Error Resume Next
  11. Dim ABCD As New MCDK: Call ABCD.Cd_菜单("Cd_小爪Excel2008"): Set ABCD = Nothing
  12. End Sub
  13. Sub Cd_EXCEL2003菜单()
  14. On Error Resume Next
  15. Dim ABCD As New MCDK: Call ABCD.Cd_菜单("Cd_EXCEL2003菜单"): Set ABCD = Nothing
  16. End Sub
  17. Private Sub Cd_操作按钮工具菜单()
  18. On Error Resume Next
  19. Dim ABCD As New MCDK: Call ABCD.Cd_菜单("Cd_操作按钮工具菜单"): Set ABCD = Nothing
  20. End Sub
  21. Private Sub Cd_欢乐小爪社区()
  22. On Error Resume Next
  23. Dim ABCD As New MCDK: Call ABCD.Cd_菜单("Cd_欢乐小爪社区"): Set ABCD = Nothing
  24. End Sub
  25. Private Sub Cd_欢乐小爪博客()
  26. On Error Resume Next
  27. Dim ABCD As New MCDK: Call ABCD.Cd_菜单("Cd_欢乐小爪博客"): Set ABCD = Nothing
  28. End Sub
  29. Private Sub An_改善列宽()
  30. On Error Resume Next
  31. Dim ABCD As New MANK: Call ABCD.An_按钮菜单("An_改善列宽"): Set ABCD = Nothing
  32. End Sub
  33. Private Sub An_减少列宽()
  34. On Error Resume Next
  35. Dim ABCD As New MANK: Call ABCD.An_按钮菜单("An_减少列宽"): Set ABCD = Nothing
  36. End Sub
  37. Private Sub An_增加列宽()
  38. On Error Resume Next
  39. Dim ABCD As New MANK: Call ABCD.An_按钮菜单("An_增加列宽"): Set ABCD = Nothing
  40. End Sub
  41. Private Sub An_最佳行高()
  42. On Error Resume Next
  43. Dim ABCD As New MANK: Call ABCD.An_按钮菜单("An_最佳行高"): Set ABCD = Nothing
  44. End Sub
  45. Private Sub An_减少行高()
  46. On Error Resume Next
  47. Dim ABCD As New MANK: Call ABCD.An_按钮菜单("An_减少行高"): Set ABCD = Nothing
  48. End Sub
  49. Private Sub An_打勾()
  50. On Error Resume Next
  51. Dim ABCD As New MANK: Call ABCD.An_按钮菜单("An_打勾"): Set ABCD = Nothing
  52. End Sub
  53. Private Sub An_打叉()
  54. On Error Resume Next
  55. Dim ABCD As New MANK: Call ABCD.An_按钮菜单("An_打叉"): Set ABCD = Nothing
  56. End Sub
  57. Private Sub An_增加行高()
  58. On Error Resume Next
  59. Dim ABCD As New MANK: Call ABCD.An_按钮菜单("An_增加行高"): Set ABCD = Nothing
  60. End Sub
  61. Private Sub An_水平中垂直中()
  62. On Error Resume Next
  63. Dim ABCD As New MANK: Call ABCD.An_按钮菜单("An_水平中垂直中"): Set ABCD = Nothing
  64. End Sub
11楼
hlxz		 下载文件：
试着在这里 传过 传不上 文件太大
1.可以到我的QQ空间下载 ，上面有 应用的动画演示
2.可以加入 excel小爪菜单应用群 42278560

12楼
罗刚君		 excel2009版本?
未来战士?
13楼
gouweicao78		 [EM08] 俺不懂VBA，就先收藏吧。
14楼
msxpvista7		 虽然看不懂，但是很佩服楼主。
15楼
opelwang		 有点复杂，不过还是支持一下了。。
16楼
tongliaozyr		 虽然看不懂，但是很佩服楼主。
17楼
tongliaozyr		 谢谢
18楼
sendsend		 你的QQ是多少啊？
19楼
wangqilong1980		 无论如何也要顶一下喽，收了好好用。
20楼
hahaboy86		 学习了~~~
21楼
wqfzqgk		 还是用类简化一下吧，是不是有点繁琐

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素， 经与ExcelTip.Net站长Apolloh商议并征得其同意， 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示， 供有需要的人士查询使用，也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议， 可与本人沟通提出，或于本站点留言，我们会尽快处理。 在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

猜您喜欢
评论列表
搜索

鄂ICP备2021011689号-2

powered by emlog pro Theme By 蓝叶

sitemap