Relative Zellverknüpfungen mit VBA erstellen

  • Excel

Es gibt 6 Antworten in diesem Thema. Der letzte Beitrag () ist von peterfido.

    Relative Zellverknüpfungen mit VBA erstellen

    Hallo,

    leider habe ich bereits mehrere Stunden an dem Problem zu knabbern und weiß die Lösung nicht:

    Folgende Situation ist die Grundlage:

    Es wird verlangt, ein Excel-Dokument mit relativen Pfaden miteinander zu verknüpfen.
    Dies soll über ein Makro geschehen, was kein Problem für mich wäre, wenn ich die Formel mit relativen Pfaden hinkriegen würde.


    Alle Dateien sind in unterschiedlichen Ordnern und dürfen nicht verschoben werden.

    Nun die Frage: wie kann man Zellen von Datei x zu Datei y verknüpfen? Alle Pfade müssen relativ sein, absolut ist nicht erlaubt.

    Folgende Formel jedoch mit absoluten Pfaden, funktioniert bereits: = 'C:\test2\[Ziel.xlsx]Tabelle1'!$A$1

    Sobald die Ordner Test1 (wo die Formel enthalten ist) und Test2 in einen Urdnerordner verschoben wird, funktioniert die Verlinkung gar nicht mehr.

    Hat jemand eine Lösung oder muss dies über absolute Pfade erzwungen werden?
    Versuchs mal irgendwie so

    VB.NET-Quellcode

    1. Option Explicit
    2. Private Sub Start()
    3. Dim xlsName As String, subFolder As String
    4. xlsName = "Excel2.xlsx"
    5. subFolder = "temp"
    6. Me.Cells(1, 1).FormulaR1C1 = GetFormulaString(xlsName, subFolder)
    7. End Sub
    8. Private Function GetActualFolder() As String
    9. getActualFolder = Application.ActiveWorkbook.FullName
    10. getActualFolder = Mid(getActualFolder, 1, InStrRev(getActualFolder, "\"))
    11. End Function
    12. Private Function GetFormulaString(ByVal xlsName As String, ByVal subFolder As String) As String
    13. GetFormulaString = "='" & GetActualFolder & subFolder & "\" & "[" & xlsName & "]" & "Tabelle1'!R1C1"
    14. End Function


    Freundliche Grüsse

    exc-jdbi
    Hallo,

    um mit relativen Pfaden zu arbeiten, muss in den Excel Optionen>Erweitert>Weboptionen die Aktualisierung der Links beim speichern abgeschaltet werden. Sonst macht Excel automatisch aus relativen absolute Pfade.

    Ansonsten ein Dokument im selben Pfad relaiv hinzuzufügen geschieht mit "./andererDateiname".
    Gruß
    Peterfido

    Keine Unterstützung per PN!

    peterfido schrieb:

    Hallo,

    um mit relativen Pfaden zu arbeiten, muss in den Excel Optionen>Erweitert>Weboptionen die Aktualisierung der Links beim speichern abgeschaltet werden. Sonst macht Excel automatisch aus relativen absolute Pfade.

    Ansonsten ein Dokument im selben Pfad relaiv hinzuzufügen geschieht mit "./andererDateiname".


    Hallo, danke für die Info.
    Da ich keine Lösung gefunden habe, absolute Dateipfade in relative zu übersetzen - und der Chef sich auch mit absoluten Pfaden zufrieden gegeben hatte - wurde es eben mit absoluten Pfaden bewerkstelligt.

    Gunngir schrieb:


    Da ich keine Lösung gefunden habe, absolute Dateipfade in relative zu übersetzen.


    Ja, das habe ich auch noch auf meiner ToDo-Liste (gehabt).

    Hier mal mein erster Entwurf.
    Ausgiebig testen werde ich das erst später auf der Arbeit, bevor ich es in mein ExcelTool einbaue.

    Visual Basic-Quellcode

    1. Option Explicit
    2. Public Sub test()
    3. Dim S As String
    4. Dim S1 As String ' = "G:\Work\Office\Test\Test2\Links.xlsm"
    5. 'Const S2 = "G:\Work\Office\hier\hier1\Wichtig.png"
    6. Const S2 = "G:\Work\Office\Test\Test2\Wichtig.png"
    7. 'Const S2 = "G:\Work\Office\Test\Test2\Test3\Test4\Test5\Wichtig.png"
    8. S1 = ThisWorkbook.Path
    9. S = AbsRel(S1, S2)
    10. If S = "" Then
    11. Debug.Print "Kein Link gefunden, evtl. unterschiedliche Laufwerke / Domains?"
    12. Else
    13. Debug.Print S
    14. End If
    15. End Sub
    16. Public Function AbsRel(ByVal LinkAblage As String, ByVal LinkZiel As String) As String
    17. Dim LA As Variant
    18. Dim LZ As Variant
    19. Dim l As Long
    20. Dim ll As Long
    21. Dim max As Long
    22. Dim S As String
    23. LinkAblage = Replace$(LinkAblage, "\", "/", , , vbTextCompare)
    24. LinkZiel = Replace$(LinkZiel, "\", "/", , , vbTextCompare)
    25. If InStr(1, LinkAblage, "/", vbTextCompare) > 0 And InStr(1, LinkZiel, "/", vbTextCompare) > 0 Then
    26. LA = Split(LinkAblage, "/", , vbTextCompare)
    27. LZ = Split(LinkZiel, "/", , vbTextCompare)
    28. If LA(0) = LZ(0) Then
    29. If UBound(LA) > UBound(LZ) Then
    30. max = UBound(LZ)
    31. Else
    32. max = UBound(LA)
    33. End If
    34. Debug.Print "max:" & max
    35. Do
    36. l = l + 1
    37. If l > max Then
    38. Exit Do
    39. End If
    40. Loop While LA(l) = LZ(l)
    41. If UBound(LA) > 0 Then
    42. For ll = l To UBound(LA)
    43. S = S & "../"
    44. Next
    45. End If
    46. If Right$(S, 1) = "/" Then
    47. S = Left$(S, Len(S) - 1)
    48. End If
    49. For ll = l To UBound(LZ)
    50. S = S & "/" & LZ(ll)
    51. Next
    52. If Left$(S, 1) = "/" Then
    53. S = "." & S
    54. End If
    55. AbsRel = S
    56. End If
    57. End If
    58. End Function
    Gruß
    Peterfido

    Keine Unterstützung per PN!