Dim intOfficceVersion As Integer

''Private Sub ReferencesVB()

'' Application.CmdBars(1).Visible = True 'строка меню если глюк

'' '===============================================

'' 'определяем версию офиса(через excel)

'' intOfficceVersion = 0: ExcelInstalled

'' '===============================================

'' 'убиваем MISSING

'' RemoveLibraryMISSING

'' '===============================================

'' 'подключаем библиотеки

'' AddLibrary

''End Sub

Function FnExcelInstalled() As Integer

'проверка версии установленного офиса

'Создает объект Excel и проверяет версию

On Error Resume Next

Dim objExcel As Object

Set objExcel = CreateObject("Excel.Application")

ExcelInstalled = (Err.Number <> 429) 'установлен или нет офис

'если установлен - проверяем версию

If ExcelInstalled Then FnExcelInstalled = Left(objExcel.Version, 2)

Set objExcel = Nothing

End Function

Function AddLibrary()

Application.CmdBars(1).Visible = True 'строка меню если глюк

RemoveLibraryMISSING 'убиваем ошибки библиотек

intOfficceVersion = FnExcelInstalled 'определяем версию офиса

ReDim arrReferences(1 To 2)

On Error Resume Next

PatharrReferences = "C:\Program Files (x86)\Microsoft Office\Office"

'библиотека excel

arrReferences(1) = PatharrReferences & intOfficceVersion & "\EXCEL.EXE"

'библиотека outlook

arrReferences(2) = PatharrReferences & intOfficceVersion & "\MSOUTL.OLB"

For i = 1 To UBound(arrReferences)

iReferencesFullName = arrReferences(i)

Application.VBE.ActiveVBProject.References.AddFromFile iReferencesFullName

Next

'C:\Program Files (x86)\Microsoft Office\Office14\EXCEL.EXE

'C:\Program Files (x86)\Microsoft Office\Office14\MSOUTL.OLB

'C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE

'C:\Program Files (x86)\Microsoft Office\Office15\MSACC.OLB"

'"C:\Program Files (x86)\Common Files\System\ado\msadox28.tlb"

'"C:\Program Files (x86)\Common Files\System\ado\msadox.dll"

'"C:\PROGRA~2\COMMON~1\MICROS~1\VBA\VBA7.1\VBE7.DLL" 'VBA

'"C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE" 'Excel

'"C:\Windows\SysWOW64\stdole2.tlb" 'stdole

'"C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE15\MSO.DLL" 'Office

'"C:\Windows\SysWOW64\scrrun.dll" 'Scripting

'"C:\Program Files (x86)\Microsoft Office\Office15\MSWORD.OLB" 'Word

'"C:\Program Files (x86)\Microsoft Office\Office15\MSACC.OLB" 'Access

'"C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE15\ACEDAO.DLL" 'DAO

'Application.VBE.ActiveVBProject.References.AddFromFile iReferencesFullName

End Function

'======================================================================

Function RemoveLibraryMISSING()

' проверка библиотек на "MISSING"

Dim iReference As Object, iReferences As Object 'или Variant

Set iReferences = Application.VBE.ActiveVBProject.References

'Application.VBE.CodePanes(3).CodeModule.AddFromFile "c:\Code Files\book2.frm"

For Each iReference In iReferences

Debug.Print iReference.Name & "===================================="

Debug.Print iReference.GUID ' : Guid : "{000204EF-0000-0000-C000-000000000046}" : String

Debug.Print iReference.FullPath

If (iReference.IsBroken) Then iReferences.Remove Reference:=iReference

Next iReference

End Function

'======================================================================

Sub iReferenceCount()

'какие библиотеки подключены

Dim i As Integer

x = Application.VBE.ActiveVBProject.References.Count

For i = 1 To x

Debug.Print Application.VBE.ActiveVBProject.References(i).Name

Next

End Sub

''''Dim ref

''''Set ref = Application.VBE.ActiveVBProject.References("JRO")

''''Application.VBE.ActiveVBProject.References.Remove ref

'======================================================================

'======================================================================

'yaser, Я узнавал так. Делал новую книгу и подключал к ней все необходимые библиотеки, _

а потом выполнял вот такой код

'Private Sub ReferencesExcel()

' i = 1

' For Each ref In ActiveWorkbook.VBProject.References

' Cells(i, 1) = ref.Name

' Cells(i, 2) = ref.GUID

' i = i + 1

' Next

'

'End Sub

'В итоге получал список имя библиотеки и её GUID. Еще можно в цикл написать Cells(i, 3) = ref.FullPath - он покажет _

путь к библиотеке.

'Только библиотеки на машину пользователя по любому ставить нужно будет. Код избавит только от необходимости руками _

подключать библиотеки в VBA.

'======================================================================

'======================================================================

'Clear '

'Пришел примерно к таком же коду, что и ты. Вот примерчик, где библиотека и информация по ней находися к _

'коллекции связей, потом связь разрывается и снова восстанавливается - уже через имя файла (можно также по GUID):

'Visual BasicВыделить код

'Private Sub Test()

' Dim i As Long, n As Long, b As Long, s As String

'

' n = ThisWorkbook.VBProject.References.Count

' i = 1

' b = False

' Do While i <= n

' If ThisWorkbook.VBProject.References(i).Description = "Microsoft Windows Common Controls-2 6.0 (SP4)" Then

' b = True

' Exit Do

' End If

' i = i + 1

' Loop

' If b Then

' Debug.Print "Description = "; ThisWorkbook.VBProject.References(i).Description

' Debug.Print "Name = "; ThisWorkbook.VBProject.References(i).Name

' Debug.Print "GUID = "; ThisWorkbook.VBProject.References(i).GUID

' Debug.Print "FullPath = "; ThisWorkbook.VBProject.References(i).FullPath

' s = ThisWorkbook.VBProject.References(i).FullPath

' ' Удалить ссылку

' ThisWorkbook.VBProject.References.Remove ThisWorkbook.VBProject.References(i)

' End If

'

' ' Добавить ссылку

' ThisWorkbook.VBProject.References.AddFromFile s

'End Sub

'======================================================================

'======================================================================

'Sub ref_check()

'

' Dim i As Integer

'

' With VBProject.References

' For i = 1 To .Count

' Debug.Print .Item(i).GUID, .Item(i).Description, .Item(i).Major, .Item(i).Minor

' a = .Item(i).GUID

' b = .Item(i).Description

' C = .Item(i).Major

' D = .Item(i).Minor

'

' If .Item(i).GUID = "{420B2830-E718-11CF-893D-00A0C9054228}" Then Exit Sub

'

' Next i

' 'Microsoft scripting

' .AddFromGuid "{420B2830-E718-11CF-893D-00A0C9054228}", 1, 0

' End With

'

'End Sub

'VBA

'C:\PROGRA~2\COMMON~1\MICROS~1\VBA\VBA7.1\VBE7.DLL

'Excel

'C:\Program Files (x86)\Microsoft Office\Office15\EXCEL.EXE

'stdole

'C:\Windows\SysWOW64\stdole2.tlb

'Office

'C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE15\MSO.DLL

'Scripting

'C:\Windows\SysWOW64\scrrun.dll

'Word

'C:\Program Files (x86)\Microsoft Office\Office15\MSWORD.OLB

'Access

'C:\Program Files (x86)\Microsoft Office\Office15\MSACC.OLB

'stdole

'C:\Windows\SysWOW64\stdole2.tlb

'DAO

'C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE15\ACEDAO.DLL

'Office

'C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE15\MSO.DLL

''For Each ref in Application.Workbooks _('ВашаКнига_Имя.xls').VBProject.References

''If ref.IsBroken then Application.Workbooks _('ВашаКнига_Имя.xls').VBProject.References.Remove ref

''Next ref

'''

'''1.Сервис –> Макросы –> Безопасность –> Надёжные источники:

'''Доверять доступ к Visual Basic Project (ToolsMacroSecurity, Trust access to VB project).

'''

'''2. Определение GUID для дальнейшего испоьзования в программах:

'''strGuid = Application.ThisWorkbook.VBProject.References(1).Guid

'''(References 2, 3 и т.д. - те, что нужны, или все в цикле)

'''

'''3. Динамическое добавление ссылки (например):

'''Application.Workbooks('ВашаКнига_Имя.xls').VBProject.References.AddFromGuid _

''''{0002E157-0000-0000-C000-000000000046}', 0, 0