|
|
Для того, чтобы программно определить подключена ли нужная настройка, можно воспользоваться любым из представленных здесь вариантов. В качестве примера использована стандартная надстройка Поиск решения. Option Compare Text
Private Sub IsAddInInstalled()
Dim iAddIn As AddIn
For Each iAddIn In AddIns
If iAddIn.Installed = True Then
If iAddIn.Name = "SOLVER.XLA" Then
MsgBox "Надстройка Поиск решения подключена", , ""
Exit Sub
End If
End If
Next
MsgBox "Надстройка Поиск решения не подключена", , ""
End Sub
| Option Compare Text
Private Sub IsAddInInstalled2()
For iCount& = 1 To AddIns.Count
If AddIns(iCount&).Installed = True Then
If AddIns(iCount&).Name = "SOLVER.XLA" Then
MsgBox "Надстройка Поиск решения подключена", , ""
Exit Sub
End If
End If
Next
MsgBox "Надстройка Поиск решения не подключена", , ""
End Sub
| Private Sub IsAddInInstalled3()
Dim iAddIn As AddIn
For Each iAddIn In AddIns
If StrComp(iAddIn.Name, "SOLVER.XLA", vbTextCompare) = 0 Then
If iAddIn.Installed = True Then
MsgBox "Надстройка Поиск решения подключена", , ""
Exit Sub
End If
End If
Next
MsgBox "Надстройка Поиск решения не подключена", , ""
End Sub
| 
Private Sub CreateReportAddIns()
Workbooks.Add xlWBATWorksheet
Application.ScreenUpdating = False
For iCount& = 1 To AddIns.Count
iIndex& = iCount& + 1 '' Long vs Integer
Cells(iIndex&, 1) = AddIns(iCount&).Name
Cells(iIndex&, 2) = AddIns(iCount&).FullName
Cells(iIndex&, 3) = AddIns(iCount&).Installed
If UCase(Cells(iIndex&, 1)) Like "*.XLA" Then
Cells(iIndex&, 4) = AddIns(iCount&).Title
Cells(iIndex&, 5) = AddIns(iCount&).Author
Cells(iIndex&, 6) = AddIns(iCount&).Comments
End If
Next
With Cells(1, 1).Resize(1, 6) 'Range("A1:F1")
.Value = Array _
("Name", "Full Name", "Installed", "Title", "Author", "Comments")
.Font.Bold = True
.EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
End Sub
Примечание : Если надстройка не содержит комментария (описания), то
возможно возникновение ошибки.
| Private Sub CreateReportAddIns2()
On Error Resume Next
Application.ScreenUpdating = False
Workbooks.Add xlWBATWorksheet
Dim iAddIn As AddIn, iRow&
For Each iAddIn In AddIns
iRow = iRow + 1
Cells(iRow, 1) = iAddIn.Name
Cells(iRow, 2) = iAddIn.FullName
Cells(iRow, 3) = iAddIn.Installed
Cells(iRow, 4) = iAddIn.Title
Cells(iRow, 5) = iAddIn.Author
Cells(iRow, 6) = iAddIn.Comments
Next
With Cells(1, 1).Resize(1, 6) 'Range("A1:F1")
.Value = Array _
("Name", "Full Name", "Installed", "Title", "Author", "Comments")
.Font.Bold = True
.EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
End Sub
| В меню Сервис выберите команду Надстройки, затем в появившемся диалоговом окне установите "флажок" напротив нужной надстройки и нажмите кнопку ОК. Если необходимая надстройка отсутствует в списке, то кликните кнопку Обзор, а затем, используя окно выбора файлов, найдите нужную надстройку, выберите её и и нажмите кнопку ОК. В меню Вид выберите пункт Панели инструментов и команду Настройка. Затем, выделите закладку Команду, в списке Категории выберите Сервис, а в соседнем списке Команды выберите Надстройки для модели COM. Кликните по ней левой кнопкой мышкой и, не отпуская кнопку, перетащите выделенную команду, к примеру, в меню Сервис, после чего отпустите кнопку мышки. Закройте диалоговое окно нажатием кнопки Закрыть (выполните все перечисленные пункты только один раз, в дальнейшем, просто используйте созданную команду, см. далее) Теперь, в меню Сервис выберите команду Надстройки для модели COM, затем в появившемся диалоговом окне установите "флажок" напротив нужной надстройки и нажмите кнопку ОК. Если необходимая надстройка отсутствует в списке, то кликните кнопку Добавить, а затем, используя окно выбора файлов, найдите нужную надстройку, выберите её и и нажмите кнопку ОК. Вариант I. Application.Dialogs(xlDialogAddinManager).Show
Если необходимо "отловить" нажатие кнопок Отмена или Закрыть [X]
| If Application.Dialogs(xlDialogAddinManager).Show = True Then MsgBox "Вы осуществили некоторые действия с надстройками" Else MsgBox "Вы отказались от дальнейших действий" End If
Вариант II.
| Application.CommandBars.FindControl(Id:=943).Execute
Если команда "Надстройка..." может быть удалена или заблокирована, то :
| Dim iControl As CommandBarButton Set iControl = Application.CommandBars.FindControl(Id:=943) If Not iControl Is Nothing Then iControl.Enabled = True iControl.Execute End If
| Если нужная надстройка отображается в стандартном диалоговом окне  Надстройки,
то для её подключения(загрузки) достаточно использовать :
AddIns("Пакет анализа").Installed = True |
| AddIns("Моя_надстройка").Installed = True |
Если это не так, то необходимо предварительно добавить нужную надстройку, а затем
подключить её. Для этого можно использовать метод | Add
семейства AddIns
AddIns.Add(FileName:="C:\Program Files\Microsoft Office\Office\Library\Autosave.xla").Installed = True
|
|
AddIns.Add(FileName:="C:\Program Files\Microsoft Office\Office\Library\Print.xla").Installed = True
|
|
AddIns.Add(FileName:="C:\Windows\Application Data\Microsoft\AddIns\Print.xla").Installed = True
|
Примечание : Не забудьте предварительно проверить наличие указанной надстройки
[FAQ44] иначе, в случае отсутствия надстройки, Вы
получите ошибку.
| Если при подключении надстройки её нужно скопировать в папку для надстроек (по умолчанию), то в этом случае, можно использовать необязательный аргумент CopyFile
AddIns.Add(FileName:="A:\Add-Ins\myAddIn.xla", CopyFile:=True).Installed = True
|
| Если необходимо отловить ручное или программное подключение надстройки, то : Вариант I. Любой стандартный модуль надстройки Private Sub Auto_Add()
'Здесь необходимые действия
End Sub
Вариант II. Только модуль книги ThisWorkbook(ЭтаКнига) надстройки
| Private Sub Workbook_AddinInstall()
'Здесь необходимые действия
End Sub
| Если необходимо отловить ручное или программное отключение надстройки, то : Вариант I. Любой стандартный модуль надстройки Private Sub Auto_Remove()
'Здесь необходимые действия
End Sub
Вариант II. Только модуль книги ThisWorkbook(ЭтаКнига) надстройки
| Private Sub Workbook_AddinUninstall()
'Здесь необходимые действия
End Sub
| Для того, чтобы программно сохранить открытую рабочую книгу (указав вместо "Имя_открытой_книги" имя нужной рабочей книги, например, "Office.xls") в виде надстройки, а также, создать нужное название и комментарий, которые будут отображаться в стандартном диалоговом окне Надстройки (после подключения),
можно воспользоваться представленным вариантом :
Private Sub FileSaveAs_AddIn()
With Application
iFileName = .GetSaveAsFilename( _
InitialFileName:="MSOffice", _
FileFilter:="Надстройка Microsoft Excel (*.xla), *.xla", _
Title:="Выберите нужную папку и введите нужное имя надстройки")
If iFileName <> False Then
.DisplayAlerts = False
.Workbooks("Имя_открытой_книги").SaveAs _
FileName:=iFileName, FileFormat:=xlAddIn
With .Workbooks(Dir(iFileName))
.IsAddin = True
.Title = "Моя надстройка"
.Comments = "Назначение надстройки пока не известно"
.Save '+ Подключение надстройки
'.Close saveChanges:=True 'Или закрытие с сохранением изменений
End With
.DisplayAlerts = True
Else
MsgBox "Необходимо было указать местосохранение надстройки", vbCritical, ""
End If
End With
End Sub
| При работе с надстройкой, личной книгой макросов "Personal.xls" и другими книгами, которые используются для хранения "общих" макросов, почти всегда существует вероятность, что макрос может быть запущен при отсутствии активной рабочей книги (данные которой, как правило, и требуется обработать) В этом случае, Вы получите ошибку, которую легко можно избежать, если воспользоваться нижеопубликованным решением (сообщения, конечно же, используются только для наглядности) If Not ActiveWorkbook Is Nothing Then MsgBox "Вы можете работать с активной рабочей книгой", , "" Else MsgBox "Вы не можете работать с несуществующей книгой", , "" End If
| If ActiveWorkbook Is Nothing Then MsgBox "Вы не можете работать с несуществующей книгой", , "" Exit Sub End If
| 1. Если исполняемый код находится в нужной надстройке, то обратиться к рабочему листу и диапазону можно так : Dim iList As Worksheet, iDiapazon As Range
Set iList = ThisWorkbook.Worksheets(1)
Set iDiapazon = iList.Range("A1:C100")
| Dim iList As Worksheet, iDiapazon As Range
Set iList = ThisWorkbook.Worksheets("Лист1")
Set iDiapazon = iList.Range("Имя_диапазона")
| With ThisWorkbook.Worksheets(1)
With .Range("A1:F100")
End With
End With
P.S. Если же код находится в модуле книги ThisWorkbook(ЭтаКнига),
то | ThisWorkbook можно заменить на Me или
вовсе убрать, т.е. все три нижеприведённых инструкции эквиваленты и
позволят получить имя первого рабочего листа.
Private Sub Workbook_Open()
MsgBox Worksheets(1).Name
MsgBox Me.Worksheets(1).Name
MsgBox ThisWorkbook.Worksheets(1).Name
End Sub
2. Если же Вам необходимо получить доступ к об'ектам подключённой
надстройки, что называется, извне, то в таком случае, можно
использовать следующий синтаксис :
| With Workbooks("Моя_надстройка.xla")
'Об'ект Workbook
With .Worksheets(1)
'Об'ект Worksheet
With .Range("A1:C1")
'Об'ект Range
End With
End With
End With
|
|
Воспроизведение любых опубликованных здесь материалов возможно только с
письменного разрешения автора :