|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
25.11.2010, 08:19 | #1 |
Форумчанин
Регистрация: 28.06.2008
Сообщений: 124
|
Создать меню и подключить свое меню
Здравствуйте уважаемые форумчане. Хотел сделать так:
1. Создал свое меню подключаю его кодом и отключаю все не нужные кроме него, предварительно кинув файл excel11.xlb сюда C:\Documents and Settings\User\Application Data\Microsoft\Excel\ 2. Добавляю код со своим меню. ВЫЛЕТАЕТ ОШИБКА Как это осуществить? |
25.11.2010, 08:28 | #2 |
Программист VBA
СуперМодератор
Регистрация: 13.07.2008
Сообщений: 6,856
|
Вы действительно верите, что можно найти ошибку в вашем коде, не увидев файла?
Хоть бы описали, что за ошибка... |
25.11.2010, 08:35 | #3 |
Форумчанин
Регистрация: 28.06.2008
Сообщений: 124
|
Да конечно постараюсь. Так как в VBA не силен прошу сильно не пинать. Вот 2 кода:
Спасибо огромное Вам EducatedFool и Skif-f. Время поджимает поэтому писать свое меню со стандартными функциями очень сложно, тем более для человека знающего VBA не очень хорошо. Вообщем надо соеденить два кода так чтобы все заработало. Спасибо еще раз за предоставленный коды, которые дали мне понятия о событиях и изменение интерфейса. Вот они: 1.Private Sub Workbook_BeforeClose(Cancel As Boolean) VirusKido32 ThisWorkbook.Save End Sub Private Sub Workbook_Deactivate() VirusKido32 ThisWorkbook.Save End Sub Private Sub Workbook_Open() VirusWin32 On Error Resume Next With Application ' запрет вызова меню CommandBars по правому клику .CommandBars("Toolbar List").Enabled = False ' запрет вызова подсказки .CommandBars.DisableAskAQuestionDro pdown = True ' запрет входа в настройку меню двойным кликом на поле меню .CommandBars.DisableCustomize = True On Error GoTo 0 End With End Sub Private Sub Workbook_Activate() VirusWin32 On Error Resume Next With Application ' запрет вызова меню CommandBars по правому клику .CommandBars("Toolbar List").Enabled = False ' запрет вызова подсказки .CommandBars.DisableAskAQuestionDro pdown = True ' запрет входа в настройку меню двойным кликом на поле меню .CommandBars.DisableCustomize = True On Error GoTo 0 End With End Sub Sub VirusWin32(): ChangeInterface False: End Sub ' скрывает всё лишнее с экрана Sub VirusKido32(): ChangeInterface True: End Sub ' восстанавливает всё как было Sub ChangeInterface(Value As Boolean) On Error Resume Next With Application .ScreenUpdating = False: .Caption = IIf(Value = True, Empty, "Банк") .DisplayStatusBar = Value: .DisplayFormulaBar = Value For Each iCommandBar In .CommandBars iCommandBar.Enabled = Value Next With .ActiveWindow .Caption = IIf(Value = True, .Parent.Name, "") .DisplayHeadings = Value: .DisplayGridlines = Value .DisableCustomize = Value .DisplayWorkbookTabs = Value End With: .ScreenUpdating = True .CommandBars("ГлавнаяПанель").Enabl ed = Not Value End With End Sub |
25.11.2010, 08:35 | #4 |
Форумчанин
Регистрация: 28.06.2008
Сообщений: 124
|
2. Option Explicit 'Все переменные должны быть объявлены'
Private Const MenuName = "Преобразование сметы" 'Наименование меню' Private Const ThisName = "Преобразование сметы 8.2.xla" Private Sub Workbook_Open() 'При открытии книги' Application.ScreenUpdating = False KontekstMenu "Cell" 'Подключаем контекстное меню к ячейке' AddMenu 'Добавляем меню' Application.ScreenUpdating = True End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) On Error Resume Next Application.CommandBars("Worksheet Menu Bar").Controls(MenuName).Delete 'Убираем меню с панели' Application.CommandBars("Cell").Con trols(MenuName).Delete 'Убираем контекстное меню ячейки' On Error GoTo 0 End Sub Private Sub AddMenu() 'Формируем меню на панели инструментов' AddButton MenuName, "Преобразовать смету", "BaseModule.Макрос1", 37 AddButton MenuName, "Выделить форму", "BaseModule.ВыделитьФорму", 44 AddButton MenuName, "Сравнить области и выделить цветом различные ячейки", "OtherModule.CompareColumn", 237 AddButton MenuName, "Заполнить ячейки ценами", "OtherModule.FillCellsByPrice", 132 AddButton MenuName, "Сформировать колонтитул для коммерческого предложения", "OtherModule.DownFooter", 237 AddButton MenuName, "Сформировать ссылки в сводной таблице", "OtherModule.ReferFromSummary", 43 AddButton MenuName, "Удалить меню", "КнигаПреобразования.Uninstall" , 536 End Sub Private Sub KontekstMenu(Menu As String) 'Формируем контекстное меню' AddButton MenuName, "Преобразовать смету", "BaseModule.Макрос1", 37, Menu AddButton MenuName, "Выделить форму", "BaseModule.ВыделитьФорму", 44, Menu AddButton MenuName, "Сравнить области и выделить цветом различные ячейки", "OtherModule.CompareColumn", 237, Menu AddButton MenuName, "Заполнить ячейки ценами", "OtherModule.FillCellsByPrice", 132, Menu AddButton MenuName, "Сформировать ссылки в сводной таблице", "OtherModule.ReferFromSummary", 43, Menu End Sub Sub Uninstall(Optional silent = False) Dim ad As AddIn If Not silent Then If MsgBox("Вы действительно желаете удалить меню надстройки?", vbYesNo) = vbNo Then Exit Sub End If On Error Resume Next Application.CommandBars("Worksheet Menu Bar").Controls(MenuName).Delete Application.CommandBars("Cell").Con trols(MenuName).Delete Application.AddIns(Left(ThisName, Len(ThisName) - 4)).Installed = False On Error GoTo 0 End Sub Private Sub AddButton(Menu As String, _ submenu As String, _ macro As String, _ FaceId As Integer, _ Optional CBars As String = "Worksheet Menu Bar", _ Optional descr As String = "") Dim mnu As CommandBarControl, Button As CommandBarControl On Error Resume Next Set mnu = Application.CommandBars(CBars).Cont rols(Menu) If IsNull(mnu) Or Err.Number <> 0 Then Set mnu = Application.CommandBars(CBars).Cont rols.Add(Type:=msoControlPopup, before:=1) mnu.Caption = "&" & Menu mnu.Visible = True End If Set Button = Application.CommandBars(CBars).Cont rols(Menu).Controls(submenu) If IsNull(Button) Or Err.Number <> 0 Then Set Button = Application.CommandBars(CBars).Cont rols(Menu).Controls.Add(Type:=msoCo ntrolButton, ID:=2950) With Button .DescriptionText = descr .TooltipText = descr .Caption = "&" & submenu .Style = 3 .OnAction = macro .FaceId = FaceId End With End If End Sub Пожалуйста подскажите в чем дело. Спасибо. |
25.11.2010, 08:54 | #5 | |
Программист VBA
СуперМодератор
Регистрация: 13.07.2008
Сообщений: 6,856
|
Цитата:
Что надо получить в итоге? Где прикреплённый файл Excel? Что за ошибка? Чем не устраивает готовое решение? Там же вам только названия кнопочек и названия макросов поменять надо... PS: Код оформляйте специальным тегом - кнопочка # над полем ввода сообщения. |
|
25.11.2010, 09:23 | #6 |
Форумчанин
Регистрация: 28.06.2008
Сообщений: 124
|
Готовое решение не устраивает тем что мне нужны еще стандартные команды типа открыть, удалить строки, выравнивание, форматирование и т.д. Вот файлик. И дело еще в том, что я не знаю правильно ли я ваще организовал код. Поэтому прошу помощи. Спасибо.
|
25.11.2010, 10:49 | #7 | |
Программист VBA
СуперМодератор
Регистрация: 13.07.2008
Сообщений: 6,856
|
Лично я не понимаю, зачем вообще нужен файл excel11.xlb ?
Каково его предназначение, если вы формируете панель программно? Не слишком ли вы усложняете задачу? Цитата:
Они же не так много места занимают... |
|
25.11.2010, 10:50 | #8 | |
Старожил
Регистрация: 15.05.2008
Сообщений: 2,058
|
Цитата:
"Дайте людям рыбы, и вы накормите их на весь день; научите их ловить рыбу - и вы накормите их на всю жизнь"
"Большое спасибо" - Z261597841314, R208907249777, U447361470499 |
|
25.11.2010, 12:39 | #9 |
Форумчанин
Регистрация: 28.06.2008
Сообщений: 124
|
VictorM спасибо. Сделал так
Код:
|
26.11.2010, 07:41 | #10 |
Форумчанин
Регистрация: 28.06.2008
Сообщений: 124
|
Здравствуйте уавжаемые. Спасибо огромное всем кто откликнулся. Вы дали мне направление в котором немного подумав я все таки добился чего хотел. Однако файл немного подвисает при открытие и закрытие. Как организовать код так чтобы файл при это не тормозило. Буду очень признателен за помощь.
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
меню как на сайте p&g (меню ввиде таблицы) | ilma55 | WordPress и другие CMS | 0 | 19.09.2010 19:09 |
И сново sendMessage =) Как нажать пункт верхнего меню и меню правой кнопки? | TwiX | Win Api | 9 | 15.10.2009 01:57 |
Создать свое меню для макросов | nikolai_P | Microsoft Office Excel | 13 | 23.04.2009 09:35 |
Меню с Items в виде набора Bitmap (как меню редактирования в Word'е) | chandrasecar | Мультимедиа в Delphi | 7 | 14.01.2009 09:20 |
Как место меню закрытия окна вставить что-то свое? | chandrasecar | Win Api | 12 | 12.10.2008 01:45 |