Dim strShtName As String
Sub Mybutton() '创建各表按钮
Dim sht As Worksheet, btn As Button
On Error Resume Next
For Each sht In Worksheets
With sht
If .Name <> strShtName Then
.Shapes(strShtName).Delete
'删除原有的名称为shtn的按钮,避免重复创建
Set btn = .Buttons.add(0, 0, 60, 30)
'新建按钮,释义见小贴士
With btn
.Name = strShtName
'命令按钮命名
.Characters.Text = "二级菜单"
'按钮的文本内容
.OnAction = "FFF"
'指定按钮控件所执行的宏命令
End With
End If
End With
Next
Set btn = Nothing
End Sub
Sub fff()
Call 二级菜单
End Sub
Sub 二级菜单()
' On Error Resume Next
Dim HUWF As CommandBar
For Each HUWF In Application.CommandBars
If HUWF.Name = "HH" Then HUWF.Delete '从集合中删除自定义命令栏。
Next
Set HUWF = CommandBars.add(Name:="HH", Position:=msoBarPopup) '创建一个新的命令栏并将其添加到命令栏集合中
'***************************************************
For i = 1 To Worksheets.Count - 4 + 4 Step 1 '遍历工作薄
If Worksheets(i).Visible = -1 Then '判断是否是显示的表格
Set HUWF1 = HUWF.Controls.add(Type:=msoControlButton) '要添加到指定命令栏中的控件类型
'Caption:控件标签;OnAction:控件指定宏
HUWF1.Caption = Worksheets(i).Name
HUWF1.OnAction = "HUWEIFENG"
HUWF1.FaceId = 477 + i '工作表名前增加图标
End If
Next i
'----------------新加的代码--------------------------------------------------------------
Set HUWF1 = HUWF.Controls.add(Type:=msoControlButton) '要添加到指定命令栏中的控件类型
HUWF1.Caption = "关于作者"
HUWF1.OnAction = "关于作者"
HUWF1.FaceId = 45
'***************************************************
HUWF.ShowPopup '将指定的命令栏作为快捷菜单,在指定坐标或当前光标位置显示
End Sub
Sub HUWEIFENG() '二级菜单执行返回选定的工作表
On Error Resume Next
Sheets(CommandBars.ActionControl.Caption).Select
End Sub
Sub 关于作者()
About.Show'显示窗体,~~窗体自已设计~~
End Sub
http://huwf.ysepan.com/
VBA工程密码158495758