Страницы: 1
RSS
Как найти надстройку?
 
Приветствую!  
Требуется найти загруженную неподключенную надстройку.  
Куда она девается? В workbooks ее нет, в addins тоже.  
Private Sub UserForm_Click()  
MsgBox Workbooks.Count  
For Each wb In Workbooks  
ListBox1.AddItem wb.Name  
Next  
ListBox1.AddItem " "  
MsgBox AddIns.Count  
For Each wb In AddIns  
ListBox1.AddItem wb.Name  
Next  
End Sub
 
Андрей, надстройка может оказаться здесь:  
 
Excel 2003 – меню Справка – О программе – Откл. объекты  
 
Excel 2007 – Параметры Excel -  Надстройки, внизу комбобокс Управление, выбрать Отключенные объекты - Перейти
 
ZVI, тут вопрос не в том, где нам включить эту надстройку,  
а как программно (через VBA) узнать, какие надстройки запущены в Excel.  
 
Т.е. берём мы 3 разных файла XLA, открываем их двойным щелчком,  
а потом думаем, как макросом нам получить список из этих 3 запущенных файлов.  
 
 
PS: Как-то сталкивался с подобным - полез на форумы - прочитал (вроде на этом форуме), что этот список получить не получится.
 
Public Sub CheckAddIns()  
   Dim pAddIn As AddIn  
   If Application.AddIns.Count > 0 Then  
       For Each pAddIn In Application.AddIns  
           If Not pAddIn.IsOpen Then Debug.Print pAddIn.Name  
       Next pAddIn  
   End If  
End Sub
 
Не знаю, есть ли в Excel 2003 AddIns2, но она позволяет увидеть и те надстройки, которые были просто открыты через проводник.
 
anvg, спасибо про совет насчёт Addins2 (не знал про такую штуку)  
 
Увы, Addins2 есть только в Excel 2010  
А хотелось бы, чтобы код работал и в Excel 2003-2007 (проверил - в них такого нет)
 
"а потом думаем, как макросом нам получить список из этих 3 запущенных файлов."  
Забавно, похоже, никаким. Правда в интернете не копал.  
 
А вот в момент открытия можно. Во вложении решение из книги Уокенбаха
 
*никак
 
Оказывается, хлам нельзя прикреплять.  
 
Код поместить в ThisWorkbook надстройки:  
 
Option Explicit  
Dim InstalledProperly As Boolean  
 
Private Sub Workbook_AddinInstall()  
   InstalledProperly = True  
End Sub  
 
Private Sub Workbook_Open()  
  Dim ai As AddIn, NewAi As AddIn  
  Dim M As String  
  Dim Ans As Integer  
  'Was just installed using the Add-Ins dialog box?  
  If InstalledProperly Then Exit Sub  
     
  'Is it in the AddIns collection?  
  For Each ai In AddIns  
     If ai.Name = ThisWorkbook.Name Then  
        If ai.Installed Then  
            MsgBox "This add-in is properly installed.", _  
              vbInformation, ThisWorkbook.Name  
            Exit Sub  
        End If  
     End If  
  Next ai  
         
   'It's not in AddIns collection, prompt user.  
   M = "You just opened an add-in. Do you want to install it?"  
   M = M & vbNewLine  
   M = M & vbNewLine & "Yes - Install the add-in. "  
   M = M & vbNewLine & "No - Open it, but don't install it."  
   M = M & vbNewLine & "Cancel - Close the add-in"  
   Ans = MsgBox(M, vbQuestion + vbYesNoCancel, ThisWorkbook.Name)  
   Select Case Ans  
       Case vbYes  
           ' Add it to the AddIns collection and install it.  
           Set NewAi = Application.AddIns.Add(ThisWorkbook.FullName)  
           NewAi.Installed = True  
       Case vbNo  
           'no action, leave it open  
       Case vbCancel  
           ThisWorkbook.Close  
   End Select  
End Sub
 
А все-же я его дожал!  
 
Private Sub UserForm_Activate()  
Dim wb, addn, a  
For Each wb In Workbooks  
addn = addn & " " & wb.Name  
Next  
For Each wb In AddIns  
addn = addn & " " & wb.Name  
Next  
For Each wb In Application.VBE.VBProjects  
a = Split(wb.Filename, "\")(UBound(Split(wb.Filename, "\")))  
If Not addn Like ("*" & a & "*") Then ListBox1.AddItem a  
Next  
End Sub
 
> А все-же я его дожал!  
 
Этот способ не подойдёт, если программу надо отправлять другим людям.  
Это ж придётся всем объяснять, где поставить галочку «доверять доступ к объектной модели»  
 
 
Вот бы найти способ, аналогичный Addins2, для Excel 2003-2007...
 
Эх, тоже только пришёл к такому решению.  
On Error Resume Next для проектов не созданных, но несохранённых книг.  
Public Sub FindXLA()  
   On Error Resume Next  
   Dim pVBE As VBIDE.VBE  
   Dim pProject As VBIDE.VBProject  
   Set pVBE = Application.VBE  
     
   If pVBE.VBProjects.Count > 0 Then  
       For Each pProject In pVBE.VBProjects  
           Debug.Print pProject.Filename  
       Next pProject  
   End If  
End Sub
 
"Это ж придётся всем объяснять, где поставить галочку «доверять доступ к объектной модели»"  
 
Да нет, зачем.  
Макросы пусть включат, а там макросом пропишете в реестре AccessVBOM = 1 Как в той теме:  
 
 http://www.planetaexcel.ru/forum.php?thread_id=39326&thread_id=39326&page_forum=lastpage&allnum_forum=6#post319649
 
subtlety, спасибо. Я и не знал, что эта опция применяется моментально, без перезапуска Excel... <BR>Как вы и посоветовали, написал макрос для этих целей. <BR>Если кому понадобится - опубликовал его здесь: http://excelvba.ru/code/Security
 
Пожалуйста! Рад, что совет был полезен!
 
Почитал, хорошая статья, спасибо!  
По поводу последнего макроса Вы пишете:  
"После выполнения этого макроса, уровень безопасности в Excel будет изменен на «низкий» (при следующем запуске Excel)..."  
 
Почему бы не перезапустить Excel программно? От пользователя еще меньше требуется тогда.  
 
Например так:  
 
Sub Enable_AccessVBOM_and_Macro()  
   On Error Resume Next  
   Key$ = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & Application.Version & _  
          "\Excel\Security\"  
 
   ' включаем программный доступ к объектной модели проекта VBA  
  'CreateObject("WScript.Shell").RegWrite Key$ & "AccessVBOM", 1, "REG_DWORD"  
 
   ' ставим низкий уровень безопасности (применится после перезапуска Excel)  
  CreateObject("WScript.Shell").RegWrite Key$ & "VBAWarnings", 1, "REG_DWORD"  
     
  ' Перезапускаем Excel  
   Shell "cmd.exe /c" & "ping -n 2 localhost > null&&start excel.exe"  
   Application.Quit  
End Sub
 
А вот так с сохранением рабочей области:  
 
   ' Перезапускаем Excel  
   Shell "cmd.exe /c" & "ping -n 2 localhost > null&&start  C:\Temp\resume_3.xlw"  
   Application.DisplayAlerts = False  
   Application.Save Filename:="C:\Temp\resume_3.xlw"  
   Application.Quit
 
Вот так для острастки:  
 
   Shell "cmd.exe /c" & "ping -n 2 localhost > null&&start C:\Temp\resume_3.xlw&&del C:\Temp\resume_3.xlw -f"  
   Application.DisplayAlerts = False  
   Application.Save Filename:="C:\Temp\resume_3.xlw"  
   Application.Quit
 
Вообще, по здравому размышлению в этом нет смысла.
Страницы: 1
Читают тему
Наверх