|
|
|
Junior Member
 
участник
Last Login: 01.04.2008 18:41
Сообщ.: 22,
Visits: 162
|
|
Используя событие Workbook_Open() создаю дополнительный пункт в конце стандартного меню. При закрытии книги удаляю.
Как сделать, чтобы пункт меню создавался, только в том случае, если его еще нет, а если уже есть не создавался?
|
|
|
|
|
новичок
участник
Last Login: 27.07.2007 11:18
Сообщ.: 6,
Visits: 28
|
|
| А примерный код могно глянуть? Может с условием поиграть? ;)
Незнаю че такое..
|
|
|
|
|
Junior Member
участник
Last Login: 01.04.2008 18:41
Сообщ.: 22,
Visits: 162
|
|
вот код:
Option Explicit
Dim objCmdBrPopup As CommandBarPopup
Private Sub Workbook_Open()
Set objCmdBrPopup = Application.CommandBars("Worksheet Menu Bar").Controls.Add(msoControlPopup, , , , True)
With objCmdBrPopup
.Caption = "Баланс"
With .Controls
With .Add(Type:=msoControlButton)
.Caption = "Новый лист"
.OnAction = "AddNewSheet_Run"
End With
With .Add(Type:=msoControlButton)
.Caption = "Период"
.OnAction = "Period_Run"
End With
With .Add(Type:=msoControlButton)
.Caption = "Отчет"
.OnAction = "Report_Run"
End With
With .Add(Type:=msoControlButton)
.Caption = "Список поставщиков"
.OnAction = "ListC_Run"
End With
End With
End With
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
objCmdBrPopup.Delete
End Sub
|
|
|
|
|
новичок
участник
Last Login: 27.07.2007 11:18
Сообщ.: 6,
Visits: 28
|
|
А если вообще ее не удалять?! ;) или нужно очень?
Незнаю че такое..
|
|
|
|
|
Junior Member
участник
Last Login: 01.04.2008 18:41
Сообщ.: 22,
Visits: 162
|
|
| Если открыть две книги, с таким кодом и разными именами, то появятся два одинаковых пункта. А мне надо при открытии второй, да и всех последующих книг, если пункт уже есть, то не добавлять его.
|
|
|
|
|
Supreme Being
участник
Last Login: 16.04.2008 11:44
Сообщ.: 366,
Visits: 2 473
|
|
Кривовато, но работать будет:
Dim objCmdBrPopup As CommandBarPopup
Private Sub Workbook_Open()
flag = False
For Each bar In Application.CommandBars("Worksheet Menu Bar").Controls
If Not bar.BuiltIn Then
flag = True
End If
Next
If flag = False Then create_menu
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
objCmdBrPopup.Delete
End Sub
Sub create_menu()
Set objCmdBrPopup = Application.CommandBars("Worksheet Menu Bar").Controls.Add(msoControlPopup, , , , True)
With objCmdBrPopup
.Caption = "Áàëàíñ"
With .Controls
With .Add(Type:=msoControlButton)
.Caption = "Íîâûé ëèñò"
.OnAction = "AddNewSheet_Run"
End With
With .Add(Type:=msoControlButton)
.Caption = "Ïåðèîä"
.OnAction = "Period_Run"
End With
With .Add(Type:=msoControlButton)
.Caption = "Îò÷åò"
.OnAction = "Report_Run"
End With
With .Add(Type:=msoControlButton)
.Caption = "Ñïèñîê ïîñòàâùèêîâ"
.OnAction = "ListC_Run"
End With
End With
End With
End Sub
С уважением,
|
|
|
|
|
Junior Member
участник
Last Login: 01.04.2008 18:41
Сообщ.: 22,
Visits: 162
|
|
спасибо babken76
я решил по другому
в событии Workbook_Open() до тго как добавить, просто сбрасываю по умолчанию
Application.CommandBars("Worksheet Menu Bar").Reset
и убираю удаление
Private Sub Workbook_BeforeClose(Cancel As Boolean)
objCmdBrPopup.Delete
End Sub
вместо него добавляю
Private Sub Workbook_Activate()
Application.CommandBars("Worksheet Menu Bar").Controls("Баланс").Visible = True
End Sub
Private Sub Workbook_Deactivate()
Application.CommandBars("Worksheet Menu Bar").Controls("Баланс").Visible = False
End Sub
таким образом при открытии второй и последующих книг данного типа пункт "Баланс" будет только один. При закрытии всех книг данного типа, либо при переключении на книги другого типа пункта не будет видно.
|
|
|
|
|
новичок
участник
Last Login: 21.02.2008 23:24
Сообщ.: 7,
Visits: 30
|
|
babken76,
я немного модифицировал твой код и хотел оформить его в виде надстройки. Но я столкнулся с проблемой. Из текущей книги не видны процедуры надстройки. Как можно побороть это?
Вот мой код.
Надстройка CreateCustomMenu.xla:
Dim objCmdBrPopup As CommandBarPopup
' Проверка, есть ли меню с именем sMenuName.
' Если нет, то создаем меню с именем sMenuName и подменю из массива arrSubmenus()
Public Sub CreateMenuIfNotExist(sMenuName, arrSubmenus())
flag = True
For Each bar In Application.CommandBars("Worksheet Menu Bar").Controls
If bar.Caption = sMenuName Then
flag = False
End If
Next
If flag = True Then Call create_menu(sMenuName, arrSubmenus())
End Sub
' Удаление меню, созданного при открытии этой книги.
Public Sub DeleteMenu(Cancel As Boolean)
If Not objCmdBrPopup Is Nothing Then
objCmdBrPopup.Delete
End If
End Sub
' Создание меню с именем sMenuName и подменю из массива arrSubmenus()
' arrSubmenus(0, i): название подменю
' arrSubmenus(1, i): ассоциированный макрос
' arrSubmenus(2, i): если = True, то начать новую группу
Sub create_menu(sMenuName, arrSubmenus())
Set objCmdBrPopup = Application.CommandBars("Worksheet Menu Bar").Controls.Add(msoControlPopup, , , , True)
With objCmdBrPopup
.Caption = sMenuName
For i = 0 To UBound(arrSubmenus, 2)
With .Controls
With .Add(Type:=msoControlButton)
.Caption = arrSubmenus(0, i) 'submenu name
.OnAction = arrSubmenus(1, i) 'submenu macro
.BeginGroup = arrSubmenus(2, i) 'begin a new group
End With
End With
Next i
End With
End Sub
Вызов из основной книги Excel:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DeleteMenu(Cancel)
End Sub
Private Sub Workbook_Open()
Dim arrTest1Submenus()
ReDim arrTest1Submenus(2, 2)
arrTest1Submenus(0, 0) = "submenu 1"
arrTest1Submenus(1, 0) = "macro 1"
arrTest1Submenus(2, 0) = False
arrTest1Submenus(0, 1) = "submenu 2"
arrTest1Submenus(1, 1) = "macro 2"
arrTest1Submenus(2, 1) = False
arrTest1Submenus(0, 2) = "submenu 3"
arrTest1Submenus(1, 2) = "macro 3"
arrTest1Submenus(2, 2) = True
Call CreateMenuIfNotExist("test", arrTest1Submenus())
End Sub
В процедуре Workbook_Open() при вызове проц. CreateMenuIfNotExist выдается ошибка "Sub or function not defined".
В чем дело?
|
|
|
|
| | |