Re: Der Wahnsinn mit den Add-Ins
18.06.2002 00:16:21
Fetzer
Kenne das Problem. Habe leichtsinnigerweise in unserem Büro eine selbstgeschriebene Funktionssammlung an unwissende Kollegen weitergegeben. Nach Betriebssystemumstellung o.Ä. wird benörgelt, dass beim Öffnen alter Dateien immer die Fehlermeldung mit den Verknüpfungen kommt und die Funktionen nicht mehr funzen.Ich habe keine Lösung wie mans abstellt, aber ein Workaround. Das besteht aus einem Makro, das die Verknüpfungen einer Datei durchsucht und einen Verweis auf mein Add-In sucht. Falls dieser Verweis existiert, der Pfad des Add-In-Verweises in der geöffneten Datei aber nicht mit dem Pfad meines Add-Ins auf diesem Rechner, so wird der Verweis umgebogen. Das Ganze wird über einen neuen Menupunkt unter "Extras" gestartet.
Quelltext ungefähr so :
Unter "DieseArbeitsmappe" :
Option Explicit
'Einrichtung des Menubefehl "Extras - Verknüpfung...".
'Funzt nicht mit AddInInstall-Ereignis, wenn AddIn schon beim Start von Excel
'geladen wird (Grund unbekannt). Daher Open-Ereignis mit IsAddIn-Abfrage, da
'sonst auch bei Bearbeitung der XLS-Datei der Menupunkt eingerichtet wird.
Private Sub Workbook_Open()
Dim cb As Object
If ThisWorkbook.IsAddin Then
Set cb = Application.CommandBars("Tools").Controls.add(Type:=msoControlButton, Temporary:=True)
cb.Caption = "Verknüpfung zu Add-In Akustik aktualisieren"
cb.OnAction = "Verknüpfung_anpassen"
End If
End Sub
'Löschen des Menubefehl "Extras - Verknüpfung...", falls vorhanden.
'Hier funzt das AddInUninstall-Ereignis wie gewünscht.
Private Sub Workbook_AddInUninstall()
Dim cb As Object
Set cb = Application.CommandBars("Tools").Controls
With cb(cb.Count)
If .Caption = "Verknüpfung zu Add-In Akustik aktualisieren" Then .Delete
End With
End Sub
Im Modul :
Option Explicit
Sub Verknüpfung_anpassen()
Dim v_liste As Variant, v_fullname As String
Dim a_name As String, a_fullname As String
Dim i As Integer, gefunden As Boolean
'Name dieses AddIns
a_name = UCase(ThisWorkbook.Name)
'Name dieses AddIns inkl. vollständigem Pfad
a_fullname = UCase(ThisWorkbook.FullName)
'hole Liste alle Verknüpfungen der aktiven Datei
v_liste = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(v_liste) Then
i = 0
gefunden = False
Do
i = i + 1
v_fullname = UCase(v_liste(i))
'falls Verknüpfung mit gleichem Namen gefunden
If Right(v_fullname, Len(a_name)) = a_name Then
'falls auch der Pfad übereinstimmt
If v_fullname = a_fullname Then
MsgBox "Verknüpfung mit " & v_fullname & " gefunden." & Chr(13) & "Aktualisierung nicht erforderlich."
Else
'falls nicht : anpassen !
MsgBox "Verknüpfung mit " & v_fullname & " gefunden." & Chr(13) & _
"Aktualisierung auf " & a_fullname & " wird durchgeführt." & Chr(13) & _
"Datei anschließend bitte neu speichern."
ActiveWorkbook.ChangeLink Name:=v_fullname, NewName:=a_fullname, Type:=xlExcelLinks
End If
gefunden = True
End If
Loop Until i = UBound(v_liste) Or gefunden
End If
'falls nicht gefunden
If Not gefunden Then MsgBox "Arbeitsmappe enthält keine Verknüpfung zu Add-In Akustik."
End Sub