Спасибо за ответ, The_Prist - так работает! К сожалению пришлось задействовать классы, но, похоже, иначе никак. Спасибо! С Вашими дополнениями работающий модуль теперь выглядит так (а вдруг еще кому понадобится;) :
Код
Option Explicit
'эта коллекция будет хранить все контролы с обработкой событий
Public oVBE_BarEvents As New Collection
Private Sub Ro_AddEvent(ctrl As CommandBarButton)
Dim CBarE As CBarEvents
If ctrl.Type = msoControlButton Then ' проверка - защита от собственной невнимательности (надо бы еще дать Else...)
'инициализируем класс
Set CBarE = New CBarEvents
'добавляем в класс, чтобы события обрабатывались
Set CBarE.cBarC_Event = Application.VBE.Events.CommandBarEvents(ctrl)
'добавляем в обработчики
oVBE_BarEvents.Add CBarE
End If
End Sub
Public Sub Ro_AddMenuVBE()
Dim mnuName As String, u As String
Dim N As Integer, i As Integer, c As Integer
u = "&Moё"
N = Application.VBE.CommandBars.Count
For i = 1 To N
With Application.VBE.CommandBars.Item(i)
If .Type = msoBarTypeMenuBar Then ' ищется меню-бар (д.б. под №1, но на всяк случай)
For c = 1 To .Controls.Count ' удаляется предыдущая установка моего меню
If .Controls.Item(c).caption = u Then
.Controls(u).Delete
Exit For
End If
Next
With .Controls.Add(Type:=msoControlPopup)
.caption = u
With .Controls.Add(Type:=msoControlButton, ID:=107)
.OnAction = "a_Bосстановить_Обработку_Событий"
.caption = "Bосстановить события"
.TooltipText = "Bосстановить обработку событий"
End With
Ro_AddEvent .Controls(.Controls.Count) ' тут каждый раз будет последний добавленный пункт меню
With .Controls.Add(Type:=msoControlButton, ID:=107)
.OnAction = "a_другие_обработчики"
.caption = "Bыровнить код"
.TooltipText = "Bыровнить код активного модуля"
End With
Ro_AddEvent .Controls(.Controls.Count)
With .Controls.Add(Type:=msoControlPopup)
.caption = "Работа с проектом"
With .Controls.Add(Type:=msoControlButton, ID:=107)
.OnAction = "a_другие_обработчики"
.caption = "Cохранение"
.TooltipText = "Cохранить все модули в архив"
End With
Ro_AddEvent .Controls(.Controls.Count)
' и т.д., и т.п.
End With
With .Controls.Add(Type:=msoControlButton, ID:=107)
.OnAction = "a_другие_обработчики"
.caption = "Справка"
.TooltipText = "Справка по Подключаемой Библиотеке"
End With
Ro_AddEvent .Controls(.Controls.Count)
End With
Exit For
End If
End With
Next
End Sub
Private Sub a_Bосстановить_Обработку_Событий(caption As String)
MsgBox "Bосстановить Обработку Событий - сработало!"
End Sub
Private Sub a_другие_обработчики(caption As String) ' общее название - чтобы сократить текст примера
MsgBox "сработало " & caption
End Sub
Здесь предложенные дополнения модуля просто скопированы в отдельную подпрограмму, а в мою часть внесены косметические изменения.
Предложенный же код для класса CBarEvents теперь выглядит так:
Код
Option Explicit
'объявляем кнопку с возможностью отслеживать события это событие срабатывает при клике мышью на кнопке собственно, оно единственное доступное
Public WithEvents cBarC_Event As CommandBarEvents
Private Sub cBarC_Event_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)
handled = True
CancelDefault = True
Application.Run CommandBarControl.OnAction, CommandBarControl.caption
End Sub
Узнать бы еще - почему Microsoft сделал обработчик событий для VBA именно таким хитрым способом
Создал пункты меню в VBA. Именно в панели VBA а не панели Excel'я. Создавал вот так:
Код
Public Sub Ro_AddMenuVBE()
Dim mnuName As String, u As String
Dim N As Integer, i As Integer, c As Integer
u = "&Moё"
N = Application.VBE.CommandBars.Count
For i = 1 To N
With Application.VBE.CommandBars.Item(i)
If .Type = msoBarTypeMenuBar Then
For c = 1 To .Controls.Count
If .Controls.Item(c).Caption = u Then
.Controls(u).Delete
Exit For
End If
Next
With .Controls.add(Type:=msoControlPopup)
.Caption = u
With .Controls.add(Type:=msoControlButton, ID:=107)
' изменил на "латинское" название .OnAction = "a_Bосстановить_Обработку_Событий"
.OnAction = "RestoreAlertsEvents"
.Caption = "Bосстановить события 2"
.TooltipText = "Bосстановить обработку событий"
End With
With .Controls.add(Type:=msoControlButton, ID:=107)
.OnAction = "a_Bыровнить_Код_Активного_Модуля"
.Caption = "Bыровнить код"
.TooltipText = "Bыровнить код активного модуля"
End With
With .Controls.add(Type:=msoControlPopup)
.Caption = "Работа с проектом"
With .Controls.add(Type:=msoControlButton, ID:=107)
.OnAction = "a_Cохранить_все_Модули_в_Архив"
.Caption = "Cохранение"
.TooltipText = "Cохранить все модули в архив"
End With
' и т.д., и т.п.
End With
With .Controls.add(Type:=msoControlButton, ID:=107)
.OnAction = "a_Справка_по_Подключаемой_Библиотеке"
.Caption = "Справка"
.TooltipText = "Справка по Подключаемой Библиотеке"
End With
End With
Exit For
End If
End With
Next
End Sub
В результате получается красивая картинка , но пункты .OnAction - не работают. Подпрограммы просто не вызываются и ничего не происходит.
На этой картинке показан момент остановки отладчика и видно, что обработчик присваивается (слева внизу выделено синим). А почему потом не обрабатывает? не сохраняет, что ли? При повторном входе в этот (или иной) модуль для Item 12 (со второй картинки) будет уже OnAction="" - почему?
Изменено: leonrom - 15.11.2017 13:49:32(не могу вставить рисунок)
Хоть тема и старая, однако вот сейчас пытался найти ответ - как вставить нужный мне символ в текст примечания к ячейке (или просто в ячейку Excel'я) средствами VBA. Сначала ответ не нашел, и поэтому написал код, который создает на листе матрицу со всеми возможными символами... а потом уж наткнулся на эту тему.
Код
Private Sub showSymTable()
Dim r As Long, c As Long, m As Long
m = 0
For r = 1 To 555
For c = 1 To 22
m = m + 1
With Range(Cells(r, c), Cells(r, c))
.FormulaR1C1 = ChrW(m) ' изображение спец-символа в ячейке
.ClearComments
.AddComment
.Comment.text Format(m, "@@@@") & Chr(10) & ChrW(m) ' код и изображение спец-символа в примечании
With .Comment
.Visible = False
.Shape.Width = 33
.Shape.Height = 22
End With
End With
Next
Next
End Sub
Ну, а на листе нашел нужные мне коды (значения m) вертикальных стрелок,- ChrW(8593) и ChrW(8595) . Естественно, границы для 'r' и 'c' м.б. любые.
В указанном "ошибочном" примере вход в функцию - выполняется. И аргумент передаётся, но как именно - не знаю. Поэтому и написал "как ByVal",- м.б. старшие товарищи поправят Не нашел ответ... ну разве, что сами скобки выполняют "взятие" значения... Да, синтаксис некорректен, однако неправильным он будет, если записать без пробела:
М.б. будет кому полезным мой опыт. Если при передаче аргумента указанного в вызываемой функции как ByRef оный аргумент заключить в скобки, то он передастся как ByVal и внесенные (вызываемой функцией первый символ меняется на '!') в него изменения будут утеряны. Вот пример (VBA, Excel 2010), где в комментариях показан получаемый результат:
Код
Private Sub mByRef(ByRef s As String)
Mid(s, 1, 1) = "!"
End Sub
Private Sub tByValByRef()
Const s0 = "abc"
Dim sx As String
sx = s0
mByRef sx
Debug.Print " sx " & sx ' sx !bc
sx = s0
mByRef (sx)
Debug.Print "(sx) " & sx ' (sx) abc (значение sx не изменилось!)
sx = s0
Call mByRef(sx)
Debug.Print "Call " & sx ' Call !bc
End Sub