Пакетное преобразование гиперссылок

[NewUser]

Здравствуйте. В документе есть множество длинных гиперссылок интернет-адресов, которые затрудняют восприятие текста. Есть ли возможность разом заменить текст этих гиперссылок на что-то однотипное (напр., "ссылка"), но с сохранением исходных URL для перехода по клику? Спасибо.

[mikekaganski]

К сожалению, в стандартном поиске нет возможности искать атрибут "гиперссылка". Я не знаю, умеет ли это, скажем, AltSearch, но можно воспользоваться макросами.

Код Выделить Развернуть


Sub ReplaceHyperlinks
  xText = ThisComponent.getText()
  xParEnum = xText.createEnumeration()
  Do While (xParEnum.hasMoreElements())
    ' Do not clear same hyperlinks across paragraphs
    sPrevUrl = ""
    xPara = xParEnum.nextElement()
    xTextPortionEnum = xPara.createEnumeration()
    Do While (xTextPortionEnum.hasMoreElements())
      xTextPortion = xTextPortionEnum.nextElement()
      sUrl = xTextPortion.HyperLinkURL
      If (sUrl <> "") Then
        If (sUrl <> sPrevUrl) Then
          xTextPortion.String = "link"
          ' re-apply the URL cleared by setting String
          xTextPortion.HyperLinkURL = sUrl
        Else
          ' Remove following parts of the same URL formatted differently
          xTextPortion.String = ""
        EndIf
      EndIf
      sPrevUrl = sUrl
    Loop
  Loop
End Sub


Этот макрос самый простой, он не обрабатывает многие специальные ситуации, как минимум следующие:
1. Он не заглядывает внутрь объектов типа таблиц и секций (и вообще не будет работать в документах с ними).
2. Он не проверяет и не восстанавливает особые настройки гиперссылок, типа стилей непосещённой ссылки или её target.

Так что Вам, возможно, придётся дорабатывать его под свои нужды.

[mikekaganski]

Код Выделить Развернуть

Sub ReplaceHyperLinksInText(xInterface As Object, sReplacement As String)
  If (xInterface.supportsService("com.sun.star.text.Paragraph")) Then
    sPrevUrl = ""
    xTextPortionEnum = xInterface.createEnumeration()
    Do While (xTextPortionEnum.hasMoreElements())
      xTextPortion = xTextPortionEnum.nextElement()
      If (xTextPortion.supportsService("com.sun.star.text.TextPortion")) Then
        sUrl = xTextPortion.HyperLinkURL
        If (sUrl <> "") Then
          If (sUrl <> sPrevUrl) Then
            xTextPortion.String = sReplacement
            ' re-apply the URL cleared by setting String
            xTextPortion.HyperLinkURL = sUrl
          Else
            ' Remove following parts of the same URL formatted differently
            xTextPortion.String = ""
          EndIf
        EndIf
        sPrevUrl = sUrl
      ElseIf (xTextPortion.TextPortionType = "TextField") Then
        xField = xTextPortion.TextField
        If (xField.supportsService("com.sun.star.text.TextField.URL")) Then
          ' E.g., URL fields in text boxes
          xField.Representation = sReplacement
          xTextPortion.Text.insertTextContent(xTextPortion, xField, True)
        EndIf
      EndIf
    Loop
  ElseIf (xInterface.supportsService("com.sun.star.text.TextTable")) Then
    aCellNames = xInterface.CellNames
    For Each sCellName In aCellNames
      ReplaceHyperLinksInText(xInterface.getCellByName(sCellName), sReplacement)
    Next sCellName
  ElseIf (xInterface.supportsService("com.sun.star.text.Text") Or _
          xInterface.supportsService("com.sun.star.text.CellProperties") Or _
          xInterface.supportsService("com.sun.star.drawing.TextShape")) Then
    ' Handles body text, text frames, table cells, text shapes
    xParEnum = xInterface.createEnumeration()
    Do While (xParEnum.hasMoreElements())
      ReplaceHyperLinksInText(xParEnum.nextElement(), sReplacement)
    Loop
  ElseIf (xInterface.supportsService("com.sun.star.drawing.GenericDrawPage")) Then
    For Each xDrawObj In xInterface
      ReplaceHyperLinksInText(xDrawObj, sReplacement)
    Next xDrawObj
  EndIf
End Sub

Sub ReplaceHyperLinks
  sReplacement = "link"
  xDoc = ThisComponent
  xUndo = xDoc.UndoManager
  xUndo.enterUndoContext("ReplaceHyperLinks")
  xDoc.lockControllers()
  On Error Goto Cleanup
  ReplaceHyperLinksInText(xDoc.Text, sReplacement)
  ReplaceHyperLinksInText(xDoc.DrawPage, sReplacement)
Cleanup:
  xDoc.unlockControllers()
  xUndo.leaveUndoContext()
End Sub

[NewUser]

Спасибо!