LibreOffice-Forum

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

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