'entwickelt von Winfried Radner 'e-mail: Wolf.W.Radzinski@onlinehome.de 'Benutzung frei - ohne Gewähr '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ BEISPIEL für die automatische Anpassung EXTERNER Excel Verknüpfungen '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Frage: Wenn ich das AddIn und eine XLS Datei, die Funktionen des AddIns mittels externer Verknüpfung nutzt, auf einen anderen PC oder einen anderen Pfad bzw. Ordner kopiere, WIE passe ich die in der XLS Datei gespeicherten externen Links AUTOMATISCH an die neuen Pfade an? '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Hat sich erledigt ... hab die Lösung! hab bei www.Herber.de etwas über DeleteLinks gefunden und es an die geänderten Bedingungen angepaßt ... ich darf den Link nicht löschen, da er weiterhin EXTERN ist, sich aber durch Kopie auf anderen PC der Pfad geändert hat. Also passe ich nur automatisch den Pfad an ... und hoffentlich NUR FÜR Funktionen MEINES AddIns ... es könnte ja sein, daß noch weitere externe Verknüpfungen existieren, die ich natürlich nicht ändern will/soll (z.B. Analyse-AddIn etc) um z.B. das AddIn lz_upn_bu.xla (findet man auf meiner Homepage) nach einer Pfadänderung wieder korrekt in die eigene XLS Datei einzubinden, muß man nur folgenden Code in die eigene XLS Datei einfügen UND nach einer Pfadänderung EINMAL aufrufen, danach sollten alle externen Verknüpfungen bezüglich lz_upn_bu.xla wieder funktionieren und nicht mehr den Fehler (#Name?) anzeigen! den Code gibt's auch unter: http://www.rendar.de/excel/addin_install.bas Datei runterladen, eigene XLS öffnen, mit in die VBA-Entwicklungsumgebung, im Menu Datei/Datei importieren... nach addin_install.bas suchen und die Datei importieren. VBA-Fenster schließen. '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub lz_upn_bu_install() addin_install "lz_upn_bu" End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ '+ Funktion so abgeändert, daß jetzt jede beliebige externe '+ Verknüpfung angepaßt werden kann. Der Filename des Addin '+ ohne Dateiendung wird der Funktion einfach als String übergeben! '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub addin_install(AddinTitle As String) Dim wh As Window Set wh = ActiveWindow AddinName = AddinTitle & ".xla" gefunden = False For i = 1 To AddIns.Count If AddIns.Item(i).Name = AddinName Then gefunden = True Exit For End If Next If Not gefunden Then MsgBox "Bitte " & vbnewline & vbnewline & AddinName & vbnewline & vbnewline & " suchen und als AddIn installieren!" Exit Sub End If If AddIns(AddinTitle).Installed = False Then AddIns(AddinTitle).Installed = True End If neuer_pfad = AddIns(AddinTitle).Path wh.Activate 'MsgBox ActiveWindow.Caption ChangeLinks neuer_pfad, AddinTitle End Sub Sub ChangeLinks(ByVal new_path As String, search_for As String) Dim varLink As Variant Dim intCounter As Integer Dim intPos As Integer varLink = ActiveWorkbook.LinkSources(xlExcelLinks) If Not IsEmpty(varLink) Then For intCounter = 1 To UBound(varLink) intPos = InStr(1, varLink(intCounter), search_for) If intPos > 0 Then new_path = new_path & "\" & Right$(varLink(intCounter), Len(varLink(intCounter)) - intPos + 1) ActiveWorkbook.ChangeLink Name:=varLink(intCounter), newname:=new_path, Type:=xlExcelLinks End If Next intCounter End If End Sub