[已解决]VBA_自定义菜单栏＿为每张工作表设置指定菜单

glhfgtd

跟诸位高人学习

yjwdjfqb

回复 FF7 的帖子

VBA自定义工具栏问题

楼主，请再帮我修改下这个文件，就是VBA自定义工具栏问题，修改成跟VBA自定义菜单文件一样（这个文件是你帮我做的，很喜欢，所以现在这个文件也请你帮下忙）

具体在附件中。。。。。谢谢老师。。。。

FF7

不知道你是不是这个意思，详见附件！

yjwdjfqb

回复 FF7 的帖子

有一点小问题，就是，如果，我同时打开多个EXCEL文件时，就会在其它工作薄中出现，还有就是，请楼主，把二个地方的代码合并到一起，谢谢啦。。。。

FF7

两个地方的代码并到一起，是指哪两个地方！？

yjwdjfqb

回复 FF7 的帖子

'■■■■■■■■■■设置“自定义工具栏”全部按钮代码开始■■■■■■■■■■
Sub auto_open()   '利用自动运行宏加载创建的（自定义工具栏）命令
    Dim cmd As CommandBar
    Dim ctr As CommandBarControl
    On Error Resume Next
    Application.CommandBars("自定义工具栏").Delete
    Set cmd = Application.CommandBars.Add("自定义工具栏", msoBarTop, , True)
    With cmd

        '设置下拉工具（父按钮一）
        Set ctr = .Controls.Add(msoControlPopup)
        With ctr
            .Caption = "自定义排序"   '下拉工具的名称
            '设置下拉工具（子按钮一）
            With .Controls.Add(msoControlButton)
                 .FaceId = 653   '此行表示（添加的图标设置，如果不需要直接注释掉即可。）
                 .Caption = "科室排序"   '下拉工具一的名称
                 .OnAction = "科室排序"   '执行（下拉工具一）宏命令
            End With
            '设置下拉工具（子按钮二）
            With .Controls.Add(msoControlButton)
                 .FaceId = 654
                 .Caption = "级别排序"   '下拉工具二的名称
                 .OnAction = "级别排序"   '执行（下拉工具二）宏命令
            End With
            '设置下拉工具（子按钮三）
            With .Controls.Add(msoControlButton)
                 .FaceId = 655
                 .Caption = "专业排序"   '下拉工具三的名称
                 .OnAction = "专业排序"   '执行（下拉工具三）宏命令
            End With
            '设置下拉工具（子按钮四）
            With .Controls.Add(msoControlButton)
                 .FaceId = 656
                 .Caption = "性别排序"   '下拉工具四的名称
                 .OnAction = "性别排序"   '执行（下拉工具四）宏命令
            End With
        End With

        '设置下拉工具（父按钮二）
        Set ctr = .Controls.Add(msoControlPopup)
        With ctr
            .Caption = "年龄排序"   '下拉工具的名称
            
            '设置下拉工具（子按钮一）
            With .Controls.Add(msoControlButton)
                 .FaceId = 210
                 .Caption = "年龄升序"   '下拉工具一的名称
                 .OnAction = "年龄升序"   '执行（下拉工具一）宏命令
            End With
            '设置下拉工具（子按钮二）
            With .Controls.Add(msoControlButton)
                 .FaceId = 211
                 .Caption = "年龄降序"   '下拉工具二的名称
                 .OnAction = "年龄降序"   '执行（下拉工具二）宏命令
            End With
        End With

        '设置单按钮一(有图标)
        With .Controls.Add(msoControlButton)
             .Caption = "查询系统"   '单按钮的名称
             .OnAction = "查询系统"   '执行（单按钮）宏命令
             .FaceId = 25
             .BeginGroup = True
             .Style = msoButtonIconAndCaptionBelow
        End With
        
        '设置单按钮二(有图标)
        With .Controls.Add(msoControlButton)
             .Caption = "重设条件"   '单按钮的名称
             .FaceId = 602
             .BeginGroup = True
             .OnAction = "重设条件"   '执行（单按钮）宏命令
             .Style = msoButtonIconAndCaptionBelow
        End With
        
        '设置单按钮三(有图标)
        With .Controls.Add(Type:=msoControlButton)
             .Caption = "查看数据库"
             .FaceId = 707
             .BeginGroup = True
             .OnAction = "查看数据库"
             .Style = msoButtonIconAndCaptionBelow
        End With
        
        
        .Visible = True
    End With
End Sub
'■■■■■■■■■■设置“自定义工具栏”全部按钮代码结束■■■■■■■■■■
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  Application.ScreenUpdating = False
  Dim mc As CommandBarControl
  Application.CommandBars("自定义工具栏").Visible = True
  For Each mc In Application.CommandBars("自定义工具栏").Controls
      mc.Visible = False
  Next
  
  Select Case ActiveSheet.Name
     Case "统计": GoSub s0: GoSub s1: GoSub s2: GoSub s3: GoSub s4
     Case "班级": GoSub s0:  GoSub s2: GoSub s3: GoSub s4
     Case "成绩": GoSub s4
     Case "姓名": GoSub s1
     Case Else:   Application.CommandBars("自定义工具栏").Visible = False
  End Select
  
  Application.ScreenUpdating = True
  Exit Sub
s0: Application.CommandBars("自定义工具栏").Controls("自定义排序").Visible = True: Return
s1: Application.CommandBars("自定义工具栏").Controls("年龄排序").Visible = True: Return
s2: Application.CommandBars("自定义工具栏").Controls("查询系统").Visible = True: Return
s3: Application.CommandBars("自定义工具栏").Controls("重设条件").Visible = True: Return
s4: Application.CommandBars("自定义工具栏").Controls("查看数据库").Visible = True: Return
End Sub

把这些代码合并在一起

yjwdjfqb

回复 FF7 的帖子

有一点小问题，就是，如果，我同时打开多个EXCEL文件时，就会在其它工作薄中出现，还有就是，请楼主，把二个地方的代码合并到一起，谢谢啦。。。。

FF7

你是说把代码都放在一个地方吗，不要分开放在两个模块中是吗？如果是，见附件：另外，已经修正了打开其他EXCEL工具栏切换显示的问题！

yjwdjfqb

回复 FF7 的帖子

感谢楼主，这个是我想要的东西，非常的感谢！！！

FF7

回复 yjwdjfqb 的帖子

有句话一直想跟你说，请你别太介意，应该算做是一种友情提示：      在论坛里面发帖，一般发帖者才被称为“楼主”。我们只能称为“跟帖者”。就比如说这座楼房是你建立的，那么你就是楼的主人，我们这些回帖者，只是到你楼房里面来抢沙发，抢凳子……
      今后你可以叫我FF或者兄弟均可！

PS：虽然我的头像是用的最终幻想7里面的尤菲如月，但俺是男同胞。用这个头像主要是因为我喜欢尤菲如月的那双眼睛。