Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
392to396
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
392to396
392to396
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

VBA-Verweise (Fremdbibliotheken) per VBA auswählen

VBA-Verweise (Fremdbibliotheken) per VBA auswählen
05.03.2004 12:38:29
PeterP
geht das?
hallo!
ich habe oft das problem, daß nicht die richtigen bibliotheken angewählt sind.
kann ich per vba die richtigen aktivieren und/oder checken, ob eine betreffende biliothek aktiviert ist und eine info dazu ausgeben?
was auch nicht schlecht wäre:
beim übernehmen von code aus webseiten etc. sind oft benutzerdefinierte datentypen deklariert, bei denen nicht erkennbar ist, aus welcher bibliothek die stammen - wie könnte man diese bestimmen?
gruß
peter

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA-Verweise (Fremdbibliotheken) per VBA auswählen
05.03.2004 12:47:04
Ramses
Hallo Peter
der code sollte dir als Ansatz dienen.
Die Konstanten oder deine Verweise solltest du relativ einfach anpassen können.


'Setzen aller benötigten Verweise
Sub SetReference(Ref As String)
' Häufig gebrauchte Verweise "References" setzen (2001) von hw
' Const erweitert von Ramses
Dim isRef As Boolean, i As Integer, link As Object
Const strDAO     As String = "{00025E01-0000-0000-C000-000000000046}" 'Microsoft DAO 3.6 Objects Library (DAO)
Const strADOX    As String = "{00000600-0000-0010-8000-00AA006D2EA4}" 'ADO Ext. 2.1 for DDL And Security (ADOX)
Const strADO     As String = "{00000201-0000-0010-8000-00AA006D2EA4}" 'Microsoft ActiveX Data Objects Library 2.1 (ADO)
Const strScript  As String = "{420B2830-E718-11CF-893D-00A0C9054228}" 'Microsoft Scripting Runtime (WSH, FileSystemObject)
Const strExcel9   As String = "{00020813-0000-0000-C000-000000000046}" 'Microsoft Excel 9.0 Objects Library (Excel2000)
Const strExcel10   As String = "{00024500-0000-0000-C000-000000000046}" 'Microsoft Excel 10.0 Objects Library (Excel XP)
Const strWord8    As String = "{00020900-0000-0000-C000-000000000046}" 'Microsoft Word 8.0 Objects Library (Word 97)
Const strWord9    As String = "{00020905-0000-0000-C000-000000000046}" 'Microsoft Word 9.0 Objects Library (Word 2000)
Const strWord10    As String = "{000209FF-0000-0000-C000-000000000046}" 'Microsoft Word 10.0 Objects Library (Word XP)
Const strOutlook9 As String = "{00062FFF-0000-0000-C000-000000000046}" 'Microsoft Outlook 9.0 Objects Library (Outlook 2000)
Const strOutlook10 As String = "{00020D75-0000-0000-C000-000000000046}" 'Microsoft Outlook 10.0 Objects Library (Outlook XP)
With Application.VBE.ActiveVBProject.References
    ' Aktuelle gesetzte Verweise durchgehen
    On Error GoTo KillRef
    i = 0: Do: i = i + 1: isRef = .Item(i).Name = Ref: Loop Until i% >= .count Or isRef
    If isRef Then
        If .Item(Ref).IsBroken Then ' Verweis ungültig
            .Remove .Item(Ref)
        Else                        ' Verweis ist bereits gesetzt
            GoTo Sub_Exit
        End If
    End If
    On Error GoTo Err_Check:
    ' Verweise entsprechend der Registry GUID setzen
    If Ref = "DAO" Then Set link = .AddFromGuid(strDAO, 5, 0)
    If Ref = "ADOX" Then Set link = .AddFromGuid(strADOX, 2, 1)
    If Ref = "ADO" Then Set link = .AddFromGuid(strADO, 2, 1)
    If Ref = "Script" Then Set link = .AddFromGuid(strScript, 1, 0)
    If Ref = "Excel" Then Set link = .AddFromGuid(strExcel, 1, 1)
    If Ref = "Word" Then Set link = .AddFromGuid(strWord, 8, 1)
    If Ref = "Outlook" Then Set link = .AddFromGuid(strOutlook, 9, 0)
Sub_Exit:
    Set link = Nothing
End With
Exit Sub
Err_Check:
    ' Namenskonflikt mit Verweistabelle or Index außerhalb Bereich
    If Err.Number = 32813 Or Err.Number = 9 Then
        Resume Next
    Else
        MsgBox "Error Number : " & Err.Number & vbCrLf & Err.Description
        GoTo Sub_Exit:
    End If
KillRef:
With Application.VBE.ActiveVBProject.References
    If .Item(i).IsBroken Then .Remove .Item(i)
End With
Resume Next
End Sub

     Code eingefügt mit Syntaxhighlighter 2.5

Die Bildschirmdarstellung haut hier nicht hin.
Die Konstanten müssen alle in einer Zeile stehen.

Gruss Rainer
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige