Url von Hyperlinks ändern

[toni007]

Hallo zusammen,

ich habe in einem Tabellenblatt eine Reihe von Hyperlinks zu Webseiten und Dokumenten.
Bisher benutze ich die Datei nur auf einem Ubuntu-System auf einem Laufwerk I, wo auch die Dokumente liegen:

Hier beginnt der Pfad mit 'file:///cifs/I/Unterordner/.../

Jetzt soll diese Datei auch auf einem Windowsystem laufen, mit gleicher Pfadstruktur.

Allerdings beginnt der Pfad hier mit 'file:///I:/Unterordner/.../

Ich habe versucht, die URL zu ändern, aber das funktioniert so nicht:

Code: Alles auswählen

' Wird bei 'Dokument öffnen' ausgeführt
Sub start
	If getGUIType() = 1 Then
		Call ErsetzeAlleHyperlink
	End If
End sub


Sub ErsetzeAlleHyperlink()

    Dim alterPfad As String
    Dim neuerPfad As String
    Dim myLink 'As Hyperlink
   
  
     oCalc = thisComponent
     oSheet = oCalc.sheets(0)
     oCellRange = osheet.getCellRangeByName("A1:Z100")
'auslesen der Eckpunkte  
     iErsteSpalte = oCellRange.rangeAddress.startColumn
     iErsteZeile = oCellRange.rangeAddress.startRow
     iLetzteSpalte = oCellRange.rangeAddress.EndColumn
     iLetzteZeile = oCellRange.rangeAddress.EndRow
  
     'Schleife über die Zeilen im Sheet
      For i = iErsteZeile to iLetzteZeile
       For m = iErsteSpalte to iLetzteSpalte
         oCell=osheet.getCellByPosition(m,i)
			Call FindHyperLinkInCell(oCell)
       next m
      next i   
End Sub

Sub FindHyperLinkInCell(oCell)
  Dim oText, oParEnum, oParElement, alterPfad, neuerPfad
  Dim oEnum, oElement

  oParEnum = oCell.getText().createEnumeration()

    alterPfad = "/cifs/i/"
    neuerPfad = "I:"

  Do While oParEnum.hasMoreElements ()
    oParElement = oParEnum.nextElement()
    oEnum = oParElement.createEnumeration()
    Do While oEnum.hasMoreElements ()
      oElement = oEnum.nextElement()
      If oElement.TextPortionType = "TextField" Then
        If oElement.TextField.supportsService("com.sun.star.text.TextField.URL") Then

          oElement.TextField.URL =Replace(oElement.TextField.URL, alterPfad, neuerPfad)

        End If
      End If
    Loop
  Loop
End Sub

Kann mir da jemand helfen?

Gruß Thomas

[F3K Total]

Moin,
versuche es mal hiermit:

Code: Alles auswählen

Sub FindHyperLinkInCell(oCell)
     if oCell.Textfields.count = 1 then
         oTextfield = oCell.Textfields(0)
         if oTextfield.PropertySetInfo.hasPropertyByName("URL") Then
             alterPfad = "cifs/i"
             neuerPfad = "I:"
             sUrl = oTextfield.URL
             sNewUrl = Replace(sUrl, alterPfad, neuerPfad)
             oTextfield.URL = sNewUrl
          endif
    endif
End Sub

[toni007]

Danke, klappt prima!!!