nick7inc
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
1) Для простоты разработки и установки этого дополнения (AddIn), а также его отладки я создал его в качестве обычного файла Excel. Так что начинаем с того, что открываем новый файл Microsoft Excel и сохраняем его в папку с другими *.XLS - файлами. Это будет наш основной файл, с которым мы будем дальше работать. Дело в том, что надстройку *.XLA можно отредактировать (макросы), но сложно потом записать сделанные изменения. А редактировать данные на листах неудобно, поскольку все листы в загруженной надстройке не показываются.
2) Открываем VBA. Создаём новые модули с именами, например, Button_panel_management и Excell_menu_buttons. В первый мы добавим код для добавления, удаления кнопок с панели инструментов, а также функцию-проверку, что панель существует. Во второй модуль будем писать код макросов, которые вызываются при нажатии на наши кнопки.
В Button_panel_management:
Код: Public Const Bar_name As String = "My cool Bar" 'Название вашей панели с кнопками
Const temporary_bar As Boolean = False
Const Button1_pic = "Button_Pic1" ' Это внутренни имена объектов-картинок (см. далее).
Const Button2_pic = "Button_Pic2" ' Вы же хотите нарисовать свои рисунки
Const Button3_pic = "Button_Pic3" ' на них, не так ли?
' Ну и т.д. Для каждой кнопки своя картинка.
|
Этим макросом мы добавляем панель с кнопками
Код:
Sub Add_button()
Dim c As CommandBarButton
Dim c2 As CommandBar
Dim prefix As String
' prefix нужен для режима отладки, когда наш проект работает в режиме XLS а не XLA
If ThisWorkbook.IsAddin = True Then prefix = "" Else prefix = "'"+ThisWorkbook.name + "'!"
Dim bname As String
If Not is_bar_exist() Then
' --- Создаём панель---
bname = Bar_name
Set c2 = Application.CommandBars.Add(name:=bname, Position:=msoBarTop, Temporary:=temporary_bar)
c2.Visible = False
' AutoMateCFG - имя листа в AddIn'е (не название ярлыка,
' которое видно в Excel, а именно имя, доступное в VBA)
' на котором мы выкладываем картинки - иконки для кнопок
' (будет сделано позже)
' -----------Создаём кнопку № 1
Set c = c2.Controls.Add(Type:= _
msoControlButton, ID:=2950, Temporary:=temporary_bar) ' , Before:=1
AutoMateCFG.Shapes(Button1_pic).CopyPicture
c.PasteFace
c.Style = msoButtonIcon
' Подсказка при наведении курсора на кнопку
c.TooltipText = "Fill selected foumula down while data in the left column"
' FillDown_LeftWatch - имя макроса (процедуры) в AddIn'е, который должен вызываться при нажатии кнопки
c.OnAction = prefix + "FillDown_LeftWatch"
' -----------Создаём кнопку № 2
Set c = c2.Controls.Add(Type:= _
msoControlButton, ID:=2950, Temporary:=temporary_bar)
AutoMateCFG.Shapes(Button2_pic).CopyPicture
c.PasteFace
c.Style = msoButtonIcon
c.TooltipText = "Imports Specord (XY) data to selected position."
c.OnAction = prefix + "Import"
'----------------------
' [...] ну и т.д., создаём здесь столько кнопок, скольку нужно
' ----[Завершение]----
c2.Visible = True
End If
End Sub
|
Этим макросом мы удаляем панель
Код:
Sub Delete_button()
Dim N As String
N = "*" ' Здесь будет имя
If is_bar_exist(N) Then
Application.CommandBars(N).Delete
End If
End Sub
|
Этим макросом мы проверяем, есть ли наша панель и возвращаем её имя в параметре
Код:
Function is_bar_exist(Optional ByRef bname As String = "") As Boolean
Dim bar As CommandBar
For Each bar In Application.CommandBars
If bar.name = Bar_name Then
If bname <> "" Then bname = bar.name
is_bar_exist = True: Exit Function
End If
Next
is_bar_exist = False
End Function
|
3) Далее, выделяем лист, в котором у нас будут храниться всякие настройки AddIn'а, картинки к кнопкам для панели инструментов и несколько кнопок для работы с AddIn'ом (установка на комп пользователя, а также использование режима отладки): 
Обратите внимание, у этого листа должно быть внутреннее имя (не текст ярлыка) такое же, какое используется в коде добавления кнопок (у меня AutoMateCFG). Иначе значки добавены не будут и появится сообщение об ошибке при создании кнопок.
ВНИМАНИЕ! Необходимо ниже задать имя файла, в которое будет сохраняться надстройка (см. константу This_addin_name)
Код кнопок, приведённых на картинке. Он располагается в листе, выбранным в качестве AutoMateCFG:
Код:
Option Explicit
Const This_addin_name As String = "Automate.xla"
Private Sub CommandButton1_Click() 'Detete panel button
Delete_button
End Sub
Private Sub CommandButton2_Click() 'Add panel button
Add_button
End Sub
Private Sub Unload_plugin_Click()
Manage_Addin False
End Sub
Private Sub Enable_addin_Click()
Manage_Addin True
End Sub
Private Sub Save_PlugIn_Click()
Dim path As String, name As String, v As Variant, module_name As String
Dim addins_path As String
addins_path = Application.LibraryPath
v = MsgBox("This will save this workbook, continue?", vbInformation + vbYesNo, "Atantion")
If v <> vbYes Then Exit Sub
Unload_plugin_Click
path = ThisWorkbook.path
name = ThisWorkbook.name: module_name = "XLA"
ThisWorkbook.IsAddin = True
On Error GoTo err1
ThisWorkbook.SaveAs addins_path + "\" + This_addin_name, xlAddIn
On Error GoTo 0
ThisWorkbook.IsAddin = False: module_name = "XLS"
ChDir path
On Error GoTo err1
ThisWorkbook.SaveAs path + "\" + name, xlWorkbookNormal
On Error GoTo 0
Exit Sub
err1:
MsgBox "An error occured in save operation!" + Chr$(13) + Error(Err), vbExclamation, "The " + module_name + " is not saved!"
Resume Next
End Sub
Sub Manage_Addin(turn_on As Boolean)
Dim v As AddIn, found As Boolean, addins_path As String
found = False
addins_path = Application.LibraryPath
For Each v In Application.AddIns
If v.name = This_addin_name Then v.Installed = turn_on: found = True: Exit For
Next v
' Не успел обновиться список доступных AddIn'ов
' Прописываем принудительно
If Not (found) And turn_on Then
Set v = Application.AddIns.Add(addins_path + "\" + This_addin_name)
v.Installed = True
End If
End Sub
|
4) И на последок - код, хранящийся в секции ЭтаКнига
Код:
Option Explicit
Dim xla_mode As Boolean
Private Sub Workbook_AddinInstall() ' Код выполняется, когда мы ставим галку в списке доступных AddIn'ов в Excel
Add_button
xla_mode = True
End Sub
Private Sub Workbook_AddinUninstall() ' Аналогично предыдущему, но когда мы галку убираем
Delete_button
End Sub
' Код автозапуска (срабатывает при загрузке AddIn'а)
' Если панель отсутствует, то он её добавляет
' отсюда вывод, если мы хотим спрятать панель, то её надо не удалять, а просто скрыть
' Если мы удалили пару кнопок из панели, то при перезапуске код её не трогает.
' Хотите восстановить кнопки? Просто удалите панель, она будет воссоздана при перезапуске Excel.
Private Sub Workbook_Open()
If Not LCase$(Right$(ThisWorkbook.name, 4)) = ".xla" Then
Beep
Else
If Not is_bar_exist() Then Add_button
End If
End Sub |
5) А теперь, как нам сохранить рисунки для кнопок.
Самое простое - нарисовать в самом Excel'е кнопку, скопировать её изображение, вставить в программу IrfanView, сохранить в формат Gif или PNG с указанием прозрачного цвета. Далее в Excel идём на лист с конфигурацией (тот, что на картинке выше), вставка/рисунок/из файла, вставляем рисунок из файла в лист. Копируем имя рисунка, которое у нас используется для его идентификации, например, Button_Pic1 (только без опечаток и шальных пробелов), выделяем рисунок (один раз кликаем по нему)
 и вбиваем (или вставляем) имя Button_Pic1 в поле с именами (см. рисунок). Теперь у этой картинки имя Button_Pic1, по которому можно к ней обратиться из кода при добавлении рисунка для кнопки. Аналогично делаем и для других кнопок, меняя имя рисунка (или номер: Button_Pic2).
Вроде всё. Для отладки мы открываем файл в виде XLS, используем кнопки Add/Delete Panel, проверяем и правим код. Только лучше выгрузить AddIn, если он загружен! Иначе вы рискуете перепутать, и править код не в XLS файле, а в XLA, а потом потеряете всю вашу работу (XLA файл не сохраняется). И может быть ещё конфликт с панелями, если и XLS и XLA будут пытаться добавить панель с одним и тем же именем. После работы вы сохраняете XLS файл как XLS.
Чтобы его установить в виде AddIn'а вы должны:
1) убрать панель (кнопка Delete Panel), и
2) нажимаете последовательно 3 кнопки сверху вниз в правом ряду (см. первый рисунок). При этом файл сохраняется как XLA и автоматически активируется как надстройка. Для временной дезактивации/активации надстройки можете использовать пункт меню в Excel Сервис/Надстройки.
Всё, удачи. Если есть опечатки в коде - пишите. Я его делал из одного своего проекта, удалял лишнее, може чего перемудрил.  И жду ваших отзывов.
|
Всего записей: 1138 | Зарегистр. 04-05-2007 | Отправлено: 12:16 29-03-2008 | Исправлено: nick7inc, 14:11 29-03-2008 |
|
