VBA menu的制作

原创 2012年03月27日 17:36:18
  1. Sub 创建菜单项()
  2. Dim MenuObject As CommandBarPopup
  3. Dim MenuItem As Object
  4. Call 删除菜单
  5. Set MenuObject = Application.CommandBars(1).Controls.Add(Type:=msoControlPopup, before:=11, temporary:=True)
  6. MenuObject.Caption = "泰星账务(&X)"
  7. Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
  8. MenuItem.Caption = "刷新菜单"
  9. MenuItem.OnAction = "刷新"
  10. Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
  11. MenuItem.Caption = "8月份生产日报表"
  12. MenuItem.OnAction = "打开8月份生产日报表"
  13. Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
  14. MenuItem.Caption = "9月份生产日报表"
  15. MenuItem.OnAction = "打开9月份生产日报表"
  16. Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
  17. MenuItem.Caption = "10月份生产日报表"
  18. MenuItem.OnAction = "打开10月份生产日报表"
  19. Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
  20. MenuItem.Caption = "11月份生产日报表"
  21. MenuItem.OnAction = "打开11月份生产日报表"
  22. Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
  23. MenuItem.Caption = "12月份生产日报表"
  24. MenuItem.OnAction = "打开12月份生产日报表"
  25. Set Menu = MenuObject.Controls.Add(Type:=msoControlPopup)
  26. Menu.Caption = "2011年账务"
  27. Set obj = Menu.Controls.Add(Type:=msoControlButton)
  28. obj.Caption = "1月份日报表"
  29. obj.OnAction = "打开11年1月份日报表"
  30. Set obj = Menu.Controls.Add(Type:=msoControlButton)
  31. obj.Caption = "2月份日报表"
  32. obj.OnAction = "打开11年2月份日报表"
  33. Set obj = Menu.Controls.Add(Type:=msoControlButton)
  34. obj.Caption = "3月份日报表"
  35. obj.OnAction = "打开11年3月份日报表"
  36. Set obj = Menu.Controls.Add(Type:=msoControlButton)
  37. obj.Caption = "4月份日报表"
  38. obj.OnAction = "打开11年4月份日报表"
  39. Set obj = Menu.Controls.Add(Type:=msoControlButton)
  40. obj.Caption = "5月份日报表"
  41. obj.OnAction = "打开11年5月份日报表"
  42. Set obj = Menu.Controls.Add(Type:=msoControlPopup)
  43. obj.Caption = "6月份日报表"
  44. Set MenuItem = obj.Controls.Add(Type:=msoControlButton)
  45. With MenuItem
  46.     .Caption = "查询(&F)..."
  47.     .FaceId = 1849
  48.     .OnAction = "打开查询"
  49. End With
  50. Set MenuItem = obj.Controls.Add(Type:=msoControlButton)
  51. With MenuItem
  52.     .Caption = "合并"
  53.     .FaceId = 1826
  54.     .OnAction = "合并"
  55. End With
  56. Set MenuItem = obj.Controls.Add(Type:=msoControlButton)
  57. With MenuItem
  58.     .Caption = "生成工资表"
  59.     .FaceId = 1742
  60.     .OnAction = "生成工资表"
  61. End With
  62. Set Menu = Nothing
  63. Set MenuItem = Nothing
  64. Set MenuObject = Nothing
  65. End Sub
  66. Sub 打开查询()
  67. Sheets("工资明细表查询").Select
  68. 删除快捷菜单
  69. UserForm1.Show
  70. End Sub
  71. Sub 删除菜单()
  72. On Error Resume Next
  73. Application.CommandBars(1).Controls("泰星账务(&X)").Delete
  74. On Error GoTo 0
  75. End Sub
  76. Sub 生成工资表()
  77. Dim x As Integer
  78. For x = 1 To Sheets.Count
  79.     If Sheets(x).Name = "工资表" Then
  80.         GoTo 100
  81.     End If
  82. Next x
  83. Set NewSheet = Worksheets.Add
  84. NewSheet.Name = "工资表"
  85. 100:
  86. With Sheets("工资表")
  87.     .Move After:=Sheets(Sheets.Count)
  88.     .Cells.ClearContents
  89.     .[a1] = "姓名": .[b1] = "数量": .[c1] = "金额"
  90. End With
  91. Dim objcn As New ADODB.Connection
  92. objcn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source= " & ThisWorkbook.FullName
  93. sql1 = "select 姓名,数量,金额 from [下料车间$]"
  94. sql2 = "select 姓名,数量,金额 from [五金车间$]"
  95. sql3 = "select 姓名,数量,金额 from [针车车间$]"
  96. sql4 = "select 姓名,数量,金额 from [油边车间$]"
  97. sql5 = "select 姓名,数量,金额 from [组装车间$]"
  98. Sql = sql1 & " union all " & sql2 & " union all " & sql3 & " union all " & sql4 & " union all " & sql5
  99. sql6 = "select 姓名,sum(数量),sum(金额) from (" & Sql & ") group by 姓名 order by 姓名"
  100. Sheets("工资表").[a2].CopyFromRecordset objcn.Execute(sql6)
  101. objcn.Close
  102. Set objcn = Nothing
  103. End Sub
  104. Sub 合并()
  105. Sheets("工资明细表查询").Select
  106. Dim objcn As New ADODB.Connection
  107. Dim hs As Integer
  108. Application.ScreenUpdating = False
  109. Cells.ClearContents
  110. [a1] = "日期": [b1] = "订单号": [c1] = "货号"
  111. [d1] = "工序": [e1] = "单价": [f1] = "数量": [g1] = "金额"
  112. [h1] = "姓名": [i1] = "备注"
  113. objcn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source= " & ThisWorkbook.FullName
  114. Sql = "select * from [下料车间$] union all select * from [五金车间$] union all select * from [针车车间$] union all select * from [组装车间$]  union all select * from [油边车间$]"
  115. [a2].CopyFromRecordset objcn.Execute(Sql)
  116. objcn.Close
  117. Set objcn = Nothing
  118. hs = [a65536].End(xlUp).Row + 1
  119. Cells(hs, 1) = "合计"
  120. Cells(hs, 6).Formula = "=subtotal(9,f2:f" & hs - 1 & ")"
  121. Cells(hs, 7).Formula = "=SUBTOTAL(9,G2:G" & hs - 1 & ")"
  122. Application.ScreenUpdating = True
  123. End Sub
  124. Sub 添加快捷菜单()
  125. On Error Resume Next
  126. Application.CommandBars("cell").Controls("工资查询").Delete
  127. Application.CommandBars("cell").Controls("生成工资表").Delete
  128. Dim CB As CommandBarControl
  129. Dim CC As CommandBarControl
  130. Dim CA As Long
  131. CA = Application.CommandBars("cell").Controls("剪切(&T)").Index
  132. Set CB = Application.CommandBars("cell").Controls.Add(before:=CA, temporary:=True)
  133. CB.Caption = "工资查询"
  134. CB.FaceId = 1849
  135. CB.OnAction = "打开查询"
  136. Set CC = Application.CommandBars("cell").Controls.Add(before:=CA, temporary:=True)
  137. CC.Caption = "生成工资表"
  138. CC.FaceId = 1742
  139. CC.OnAction = "生成工资表"
  140. End Sub
  141. Sub 删除快捷菜单()
  142. On Error Resume Next
  143. Application.CommandBars("cell").Controls("工资查询").Delete
  144. Application.CommandBars("cell").Controls("生成工资表").Delete
  145. End Sub
  146. Sub 刷新()
  147. Application.Run "创建菜单.xla!创建菜单"
  148. End Sub

VBA 添加简单菜单(有分割线)

ThisWorkbook里的代码: Private Sub Workbook_Open()      Call addMenu End Sub Sub addMenu()  '菜单     ...
  • jiakw_1981
  • jiakw_1981
  • 2012年04月04日 10:15
  • 1551

VBA 第14课 自动生成年历

Sub 生成年历() y = InputBox("请指定一个年份:") '清除原有内容 Range("1:1, 4:11,14:21,24:31,34:41").ClearContents '设置标题...
  • u013511642
  • u013511642
  • 2015年10月06日 14:42
  • 555

Excel VBA高效办公应用-第七章-VBA财务报表分析-Part1 (损益表的分析)

代码如下: Public Sub 损益表计算() '定义一个保存记录数的整型变量 Dim iCount As Integer '把工作表的记录数赋予iCount iCount = Sh...
  • hpdlzu80100
  • hpdlzu80100
  • 2017年06月14日 21:40
  • 631

用VBA完成报表制作

最近帮朋友做了一个报表统计的excel,因为本人比较懒,就直接用vba写了逻辑,而没有使用公式,代码实现了一些较简单的功能,例:算总收入,总支出,按月份统计的报销额度,根据财务人员给的公式自动算出管理...
  • sinat_29673403
  • sinat_29673403
  • 2016年11月24日 10:49
  • 722

excel中用vba加载宏添加菜单和按钮

‘auto_open方法 文件打开后自动运行 一般放在加载宏文件里(.xla) ’每次使用运行xla文件  就能添加自己设计好的菜单和按钮 Private Sub Auto_Open()   ...
  • chongcilingjian
  • chongcilingjian
  • 2013年05月30日 11:27
  • 2775

最近开发的基于Excel的考试系统---VBA

应朋友之邀,用EXCEL做了一个简单的考试系统,由于没有服务器,所以没有网络通信,只是简单的本地判断得分。 在每台电脑上面都可以进行考试,根据题库随机出题,交卷后自动统计分数。 共50道单项选择题...
  • liuxiaoddd
  • liuxiaoddd
  • 2016年12月03日 12:22
  • 1049

Excel VBA高效办公应用-第十三章-工资条与工资查询-Part1 (制作工资条)

同样,在如今的互联网时代,以下的工资条处理方式看上去太陈旧了。不过,十多年前,我自己还真领过这种格式的纸质工资条。哎呀,又暴露年龄了 Option Explici...
  • hpdlzu80100
  • hpdlzu80100
  • 2017年06月21日 23:50
  • 178

VSTO运行VBA代码

 昨天一个同事问我,怎么在VSTO的控件上运行工作簿中的VBA代码。这个很简单,VSTO提供了一个Run方法,可以直接运行Marco,就和你在VBA的一个过程里调用另一个过程一样。VSTO里的代码:p...
  • laoyebin
  • laoyebin
  • 2010年04月28日 23:12
  • 1717

VBA教程初级(一):简单宏

VBA教程初级(一):简单宏 针对本教程的读着,默认已经知道什么是宏,可以打开宏编辑。如果不会,请百度。百度是万能的。 进入正题,首先打开代码窗口,然后编辑窗口敲入如下代码:Pub...
  • hxq_793034963
  • hxq_793034963
  • 2016年03月01日 16:00
  • 882

第四章 怎样制作Office风格工具栏和菜单的应用程序

第四章 Xtreme Toolkit Pro v13.2 使用指南 Up | Previous | Next 怎样制作Office风格工具栏和菜单的应用程序 接下来的指南 是怎样使用Visual...
  • whucv
  • whucv
  • 2012年07月20日 22:58
  • 1996
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:VBA menu的制作
举报原因:
原因补充:

(最多只允许输入30个字)