VBA menu的制作

最新推荐文章于 2024-04-16 17:28:45 发布

jiakw_1981

最新推荐文章于 2024-04-16 17:28:45 发布

阅读量1.8k

点赞数

分类专栏：技术文章标签： vba menu 报表 sql excel c

本文链接：https://blog.csdn.net/jiakw_1981/article/details/7399860

版权

技术专栏收录该内容

23 篇文章 0 订阅

订阅专栏

Sub 创建菜单项()
Dim MenuObject As CommandBarPopup
Dim MenuItem As Object
Call 删除菜单
Set MenuObject = Application.CommandBars( 1).Controls. Add( Type:=msoControlPopup, before:= 11, temporary:= True)
MenuObject. Caption = "泰星账务(&X)"
Set MenuItem = MenuObject.Controls. Add( Type:=msoControlButton)
MenuItem. Caption = "刷新菜单"
MenuItem.OnAction = "刷新"
Set MenuItem = MenuObject.Controls. Add( Type:=msoControlButton)
MenuItem. Caption = "8月份生产日报表"
MenuItem.OnAction = "打开8月份生产日报表"
Set MenuItem = MenuObject.Controls. Add( Type:=msoControlButton)
MenuItem. Caption = "9月份生产日报表"
MenuItem.OnAction = "打开9月份生产日报表"
Set MenuItem = MenuObject.Controls. Add( Type:=msoControlButton)
MenuItem. Caption = "10月份生产日报表"
MenuItem.OnAction = "打开10月份生产日报表"
Set MenuItem = MenuObject.Controls. Add( Type:=msoControlButton)
MenuItem. Caption = "11月份生产日报表"
MenuItem.OnAction = "打开11月份生产日报表"
Set MenuItem = MenuObject.Controls. Add( Type:=msoControlButton)
MenuItem. Caption = "12月份生产日报表"
MenuItem.OnAction = "打开12月份生产日报表"
Set Menu = MenuObject.Controls. Add( Type:=msoControlPopup)
Menu. Caption = "2011年账务"
Set obj = Menu.Controls. Add( Type:=msoControlButton)
obj. Caption = "1月份日报表"
obj.OnAction = "打开11年1月份日报表"
Set obj = Menu.Controls. Add( Type:=msoControlButton)
obj. Caption = "2月份日报表"
obj.OnAction = "打开11年2月份日报表"
Set obj = Menu.Controls. Add( Type:=msoControlButton)
obj. Caption = "3月份日报表"
obj.OnAction = "打开11年3月份日报表"
Set obj = Menu.Controls. Add( Type:=msoControlButton)
obj. Caption = "4月份日报表"
obj.OnAction = "打开11年4月份日报表"
Set obj = Menu.Controls. Add( Type:=msoControlButton)
obj. Caption = "5月份日报表"
obj.OnAction = "打开11年5月份日报表"
Set obj = Menu.Controls. Add( Type:=msoControlPopup)
obj. Caption = "6月份日报表"
Set MenuItem = obj.Controls. Add( Type:=msoControlButton)
With MenuItem
. Caption = "查询(&F)..."
.FaceId = 1849
.OnAction = "打开查询"
End With
Set MenuItem = obj.Controls. Add( Type:=msoControlButton)
With MenuItem
. Caption = "合并"
.FaceId = 1826
.OnAction = "合并"
End With
Set MenuItem = obj.Controls. Add( Type:=msoControlButton)
With MenuItem
. Caption = "生成工资表"
.FaceId = 1742
.OnAction = "生成工资表"
End With
Set Menu = Nothing
Set MenuItem = Nothing
Set MenuObject = Nothing
End Sub
Sub 打开查询()
Sheets( "工资明细表查询"). Select
删除快捷菜单
UserForm1. Show
End Sub
Sub 删除菜单()
On Error Resume Next
Application.CommandBars( 1).Controls( "泰星账务(&X)"). Delete
On Error GoTo 0
End Sub
Sub 生成工资表()
Dim x As Integer
For x = 1 To Sheets. Count
If Sheets(x). Name = "工资表" Then
GoTo 100
End If
Next x
Set NewSheet = Worksheets. Add
NewSheet. Name = "工资表"
100:
With Sheets( "工资表")
. Move After:=Sheets(Sheets. Count)
.Cells.ClearContents
.[a1] = "姓名": .[b1] = "数量": .[c1] = "金额"
End With
Dim objcn As New ADODB.Connection
objcn. Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source= " & ThisWorkbook. FullName
sql1 = "select 姓名,数量,金额 from [下料车间$]"
sql2 = "select 姓名,数量,金额 from [五金车间$]"
sql3 = "select 姓名,数量,金额 from [针车车间$]"
sql4 = "select 姓名,数量,金额 from [油边车间$]"
sql5 = "select 姓名,数量,金额 from [组装车间$]"
Sql = sql1 & " union all " & sql2 & " union all " & sql3 & " union all " & sql4 & " union all " & sql5
sql6 = "select 姓名,sum(数量),sum(金额) from (" & Sql & ") group by 姓名 order by 姓名"
Sheets( "工资表").[a2].CopyFromRecordset objcn.Execute(sql6)
objcn. Close
Set objcn = Nothing
End Sub
Sub 合并()
Sheets( "工资明细表查询"). Select
Dim objcn As New ADODB.Connection
Dim hs As Integer
Application.ScreenUpdating = False
Cells.ClearContents
[a1] = "日期": [b1] = "订单号": [c1] = "货号"
[d1] = "工序": [e1] = "单价": [f1] = "数量": [g1] = "金额"
[h1] = "姓名": [i1] = "备注"
objcn. Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source= " & ThisWorkbook. FullName
Sql = "select * from [下料车间$] union all select * from [五金车间$] union all select * from [针车车间$] union all select * from [组装车间$] union all select * from [油边车间$]"
[a2].CopyFromRecordset objcn.Execute(Sql)
objcn. Close
Set objcn = Nothing
hs = [a65536]. End(xlUp).Row + 1
Cells(hs, 1) = "合计"
Cells(hs, 6).Formula = "=subtotal(9,f2:f" & hs - 1 & ")"
Cells(hs, 7).Formula = "=SUBTOTAL(9,G2:G" & hs - 1 & ")"
Application.ScreenUpdating = True
End Sub
Sub 添加快捷菜单()
On Error Resume Next
Application.CommandBars( "cell").Controls( "工资查询"). Delete
Application.CommandBars( "cell").Controls( "生成工资表"). Delete
Dim CB As CommandBarControl
Dim CC As CommandBarControl
Dim CA As Long
CA = Application.CommandBars( "cell").Controls( "剪切(&T)"). Index
Set CB = Application.CommandBars( "cell").Controls. Add(before:=CA, temporary:= True)
CB. Caption = "工资查询"
CB.FaceId = 1849
CB.OnAction = "打开查询"
Set CC = Application.CommandBars( "cell").Controls. Add(before:=CA, temporary:= True)
CC. Caption = "生成工资表"
CC.FaceId = 1742
CC.OnAction = "生成工资表"
End Sub
Sub 删除快捷菜单()
On Error Resume Next
Application.CommandBars( "cell").Controls( "工资查询"). Delete
Application.CommandBars( "cell").Controls( "生成工资表"). Delete
End Sub
Sub 刷新()
Application.Run "创建菜单.xla!创建菜单"
End Sub