现在的位置: 首页 > 综合 > 正文

VBA menu的制作

2013年08月11日 ⁄ 综合 ⁄ 共 4704字 ⁄ 字号 小 中 大 ⁄ 评论关闭
  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
返回
【上篇】
【下篇】

作者:

抱歉!评论已关闭.

返回首页

Copyright © 2013-2018 学步园  保留所有权利.
软文销售 QQ客服：2265327166 点击这里给我发消息（其他合作也可洽谈）
必威体育
必威电竞