PopUp меню в Excel

[Scorry_1]

Подскажите, пожалуйста, решение следующей проблемы:
Нужно вставить свой пункт в контекстное меню Excel, но нужно это меню только в одном из листов.
Пишу:

Код: Выделить всё

Private Sub Worksheet_Activate()
‘ добавление
Set newPopUp = CommandBars("Cell").Controls.Add(Type:=msoControlButton, before:=1)
newPopUp.Caption = "Проба"
newPopUp.OnAction = "Макрос1"
End Sub

Private Sub Worksheet_Deactivate()
‘ удаление
For i = 1 To CommandBars("Cell").Controls.Count
If CommandBars("Cell").Controls.Item(i).Caption = "Проба" Then
CommandBars("Cell").Controls.Item(i).Delete
Exit For
End If
Next i
End Sub


Все работает, все замечательно, но(!!) когда открыто несколько файлов excel и переход между ними осуществляется через меню «Окно», событие Worksheet_Deactivate() не происходит и меню становиться доступно в другой книге, чего мне совершенно не нужно.
При попытке впихнуть код удаления меню в Workbook_Deactivate() выдает ошибку «Object variable or with block variable not set». Подскажите, плиз, как мне добиться требуемого результата? Все выходные уже бьюсь как рыба об асфальт (((((

[Nicky]

Application.CommandBars...

Код: Выделить всё

Function myDeleteMenuItem(sCaption As String, Optional sErr As String) As Boolean
  Dim i As Long
  On Error GoTo er
 
  With Application.CommandBars("Cell").Controls
    i = 1
    Do Until i > .Count
      If StrComp(.Item(i).Caption, sCaption, vbTextCompare) = 0 Then
        .Item(i).Delete
      Else
        i = i + 1
      End If
    Loop
  End With
  myDeleteMenuItem = True
  GoTo ok
 
er:
  sErr = Err.Description
ok:
End Function


[Scorry_1]

Nicky, ай спасибо ) теперь все пашет

[Avtopic]

Если хочешь полностью вернуть это меню в начальное состояние, можно использовать:

Код: Выделить всё

Application.CommandBars("cell").Reset

[Scorry_1]

Avtopic, спасибо, запомню - этот метод проще

[GSerg]

Ага, проще. Только будут удалены кнопки всех остальных сторонних надстроек.

[KL]

Я бы сделал что-то в этом духе:

Код: Выделить всё

Private Sub Worksheet_Activate()
    Set newPopUp = Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton, before:=1)
    With newPopUp
        .Caption = "Проба"
        .Tag = "Проба"
        .OnAction = "Макрос1"
    End With
End Sub

Private Sub Worksheet_Deactivate()
    On Error Resume Next
    Application.CommandBars("Cell").FindControl(msoControlButton, , "Проба", , True).Delete
End Sub

Можно искать и через ID, но велик риск стереть не то, что надо в сл. сбоя первой процедуры:

Код: Выделить всё

Private Sub Worksheet_Activate()
    Set newPopUp = Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton, before:=1)
    With newPopUp
        .Caption = "Проба"
        .OnAction = "Макрос1"
    End With
End Sub

Private Sub Worksheet_Deactivate()
    On Error Resume Next
    Application.CommandBars("Cell").FindControl(msoControlButton, 1, , , True).Delete
End Sub

[KL]

Кстати в первой части переменная вроде какбы никчему:

Код: Выделить всё

Private Sub Worksheet_Activate()
    With Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton, before:=1)
        .Caption = "Проба"
        .Tag = "Проба"
        .OnAction = "Макрос1"
    End With
End Sub

[Scorry_1]

Я сделал так:

Код: Выделить всё

В модуле:

Public Sub AddMenuItem()
Dim adding As Boolean
adding = True
For i = 1 To Application.CommandBars("Cell").Controls.Count
If Application.CommandBars("Cell").Controls.Item(i).Caption = "Проба" Then adding = False
Next i
If adding = True Then
Set newPopUp = Application.CommandBars("Cell").Controls.Add(Type:=msoControlButton,  before:=1)
newPopUp.Caption = " Проба "
newPopUp.OnAction = " Макрос1"
End If
End Sub

Public Sub DelMenuItem()
On Error Resume Next
For i = 1 To Application.CommandBars("Cell").Controls.Count
If Application.CommandBars("Cell").Controls.Item(i).Caption = " Проба " Then
Application.CommandBars("Cell").Controls.Item(i).Delete
Exit For
End If
Next i
‘ тут для моих целей подходит и Application.CommandBars("Cell").Reset
End Sub

В объекте лист:

Private Sub Workbook_Activate()
If ActiveSheet.Name = "Лист1" Then
Call AddMenuItem
End If
End Sub
Private Sub Workbook_Deactivate()
Call DelMenuItem
End Sub

В объекте книга:

Private Sub Worksheet_Activate()
Call AddMenuItem
End Sub
Private Sub Worksheet_Deactivate()
Call DelMenuItem
End Sub

В Sub AddMenuItem() добавил проверку "Одноразовости добавления", т.к. иногда происходила ошибка в макросе удаления, потому и "On Error Resume Next" поставить пришлось.

[KL]

а почему не так:

Код: Выделить всё

Public Sub AddMenuItem()
    With Application.CommandBars("Cell")
        If .Controls(1).Caption = "Проба" Then Exit Sub
        With .Controls.Add(Type:=msoControlButton, before:=1)
            .Caption = "Проба": .OnAction = "Макрос1"
        End With
    End With
End Sub

Public Sub DelMenuItem()
    With Application.CommandBars("Cell").Controls(1)
        If .Caption <> "Проба" Then Exit Sub
        .Delete
    End With
End Sub

Private Sub Workbook_Activate()
    If ActiveSheet.Name = "Лист1" Then AddMenuItem
End Sub

Private Sub Workbook_Deactivate()
    DelMenuItem
End Sub

Private Sub Worksheet_Activate()
    AddMenuItem
End Sub

Private Sub Worksheet_Deactivate()
    DelMenuItem
End Sub

[KL]

тут для моих целей подходит и Application.CommandBars("Cell").Reset

Для твоих - да, а юзеру свинью не подложишь. А то как он "кустомизировал меню" - чего на свете не бывает

[Scorry_1]

а почему не так:

Мне как-то спокойнее, когда проверяются все пункты меню - уж слишком они легко добавляются и тот же юзер сам в состоянии написать макрос и впихнуть другое меню, сместив мое на вторую, третью и т.д. позицию

[KL]

Мне как-то спокойнее, когда проверяются все пункты меню - уж слишком они легко добавляются и тот же юзер сам в состоянии написать макрос и впихнуть другое меню, сместив мое на вторую, третью и т.д. позицию

Тогда совсем непонятно От чего не так (ведь быстрее и короче):

Код: Выделить всё

Sub AddMenuItem()
    With Application.CommandBars("Cell")
        If Not .FindControl(, , "Проба", , True) Is Nothing Then Exit Sub
        With .Controls.Add(Type:=msoControlButton, before:=1)
            .Caption = "Проба"
            .Tag = "Проба"
            .OnAction = "Макрос1"
        End With
    End With
End Sub

Sub DelMenuItem()
    On Error Resume Next
    Application.CommandBars("Cell").FindControl(, , "Проба", , True).Delete
End Sub

Private Sub Workbook_Activate()
    If ActiveSheet.Name = "Лист1" Then AddMenuItem
End Sub

Private Sub Workbook_Deactivate()
    DelMenuItem
End Sub

Private Sub Worksheet_Activate()
    AddMenuItem
End Sub

Private Sub Worksheet_Deactivate()
    DelMenuItem
End Sub

[Nicky]

2KL: твой код удаляет одну пробу. Что будем делать, если их оказалось несколько?

[KL]

2KL: твой код удаляет одну пробу. Что будем делать, если их оказалось несколько?

Их там не может оказаться несколько в принцыпе, поскольку AddMenuItem не добавит вторую если одна уже есть.

[Avtopic]

Можно искать и через ID, но велик риск стереть не то, что надо

Чтобы вообще не беспокоится о таких вещах, если требуется в контекстное меню что-то поменять, я делаю так:
В самом начале (напр. в Open) копирую все меню “cell” в собственный “My_cell”.

Код: Выделить всё

Public Sub New_Commandbar()
Dim Cbr As CommandBar, Ctr As CommandBarControl
On Error Resume Next
Application.CommandBars("My_cell").Delete
Application.CommandBars.Add Name:="My_cell", Position:=msoBarPopup, Temporary:=True
For Each Ctr In Application.CommandBars("cell").Controls
    With Application.CommandBars("My_cell").Controls.Add(Ctr.Type, Ctr.ID, Ctr.Parameter, , 1)
        .Caption = Ctr.Caption
'       .OnAction = Ctr.OnAction
        .BeginGroup = Ctr.BeginGroup
    End With
Next
End Sub

В Workbook_SheetBeforeRightClick ставлю:

Код: Выделить всё

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
Application.CommandBars("My_cell").ShowPopup
End Sub

и изменения которые хотел внести в CommandBar "cell" вношу в мой CommandBar " My_cell ".
И все. Не нужно беспокоится, что что-то можно удалить чужое, или смотреть за Workbook_Activate и Workbook_Deactivate
Здесь есть чего доработать, но в 90 из 100 случаев меня такой вариант устраивал.

[KL]

Чтобы вообще не беспокоится о таких вещах, если требуется в контекстное меню что-то поменять, я делаю так:
В самом начале (напр. в Open) копирую все меню “cell” в собственный “My_cell”.
[syntax="vb"]...For Each Ctr In Application.CommandBars("cell").Controls
...Next

Мой первый код уже решал эту проблему без использования доп. объектов, а последний полностью устранил возможность дублирования кнопок. Но дело даже не в этом. Использование FindControl намного эффективнее чем любой цыкл (!!!) Мне казалось, что это очевидно, но почему-то все продолжают настаивать на цыклах.

[Avtopic]

Нет, я о другом, когда я делал акцент на такое решение, на первом плане стоит, то,
что вообще не нужно сбрасывать CommandBar("cell") или убирать оттуда наши кнопки,
при активации другой книги. При таком решении это вообще не стоит на повестке дня,
у другой книги будет свое контекстное меню, у нашей свое.

[KL]

Тады ой!