含有条件的右键菜单问题

lszxsxy

右键菜单只能显示“处室”一项，其他部门项显示不出来，是条件设置的不对吧？如何设置这些条件才合适呢？
高手请帮忙呀，看看怎么修改呢？网上似乎搜索不到这样复杂的例子

[ 本帖最后由 lszxsxy 于 2011-3-17 10:11 编辑 ]

lenghonghai

不好意思，这个问题没研究过，不懂啊。

lszxsxy

没关系 我也是想研究下 为了输入人名方便 爱折腾 但是折腾不好 呵呵

jxb8088

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim oPopup As CommandBar
    Dim oSubMenu As CommandBarPopup
    Dim oMenuItem As CommandBarControl
    Set d = CreateObject("scripting.dictionary")
    Cancel = True
    On Error Resume Next
    CommandBars("TeacherMenu").Delete
    On Error GoTo 0
    Set oPopup = CommandBars.Add("TeacherMenu", msoBarPopup)
    Set oSubMenu = oPopup.Controls.Add(msoControlPopup)
    oSubMenu.Caption = "教师姓名"
    For i = 1 To 11
    Set oMenuItem = oSubMenu.Controls.Add(msoControlPopup)
    oMenuItem.Caption = Sheets(2).Cells(1, i)
    d.RemoveAll
    For j = 2 To Sheets(2).Cells(65536, Sheets(2).Rows(1).Find(Sheets(2).Cells(1, i), , , xlWhole).Column).End(xlUp).Row
    If Not d.exists(Sheets(2).Cells(j, i).Value) And Sheets(2).Cells(j, i).Value <> "" Then
    d(Sheets(2).Cells(j, i).Value) = Sheets(2).Cells(j, i).Value
    With Application.CommandBars("TeacherMenu").Controls(1).Controls(i).Controls.Add(Type:=msoControlButton)
    .Caption = Sheets(2).Cells(j, i).Value
    .OnAction = "rtclick"
    End With
    End If
    Next
    Next
    oPopup.ShowPopup
    oPopup.Delete
End Sub

klkl

如果多几张表：SHEET1，SHEET4，SHEET5.........就要出现错误
宏"rtclick"一定要放在模块中吗?
Sub rtclick()
    ActiveCell = Application.CommandBars.ActionControl.Caption
End Sub
请帮助,谢谢!

wangjian6931

留个脚印学习，以后能有用

lszxsxy

谢谢大师，代码很强大 很专业！
再问一下：要是想把第一级菜单“教师姓名”去掉，直接出现第二级各个学科菜单，怎么修改呀 我试了试 还是弄不好。麻烦大师了

lszxsxy

我也曾经那样试过 是不正常 不太清楚原因啦 呵呵

lszxsxy

再次谢过大师 我弄好了

klkl

如果多几张表：SHEET1，SHEET4，SHEET5.........就要出现错误
宏"rtclick"一定要放在模块中吗?
Sub rtclick()
    ActiveCell = Application.CommandBars.ActionControl.Caption
End Sub
请帮助,谢谢!