如何使用 LibreOffice Calc 中的宏将单元格中的第一个单词转换为超链接

Question

我有一个大型电子表格，希望自动执行将每个单元格的第一个单词转换为超链接的过程，但保持其余文本不变。 IE。 linktext 附加文本要转换为 [linktext] 附加文本（链接文本显示为链接）。我可以创建超链接，但现在看不到如何添加附加文本。我所有的努力似乎都删除了超链接。感谢您的任何帮助或建议。我的代码是：-

sub HyperLink

rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
dim linktext as String
dim appendedtext as String
dim pos
dim contents as String

rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
ThisCell = ThisComponent.CurrentSelection

rem ----------------------------------------------------------------------
rem get data from selected cell
contents = ThisCell.String
pos = Instr(contents," ") 'get position of space character

rem ----------------------------------------------------------------------

    ThisCell.clearContents(4)
    linktext = Mid(contents, 1, pos-1)
    appendedtext = Mid(contents, pos)
    dim args1(0) as new com.sun.star.beans.PropertyValue
    args1(0).Name = "ToPoint"
    args1(0).Value = ThisComponent.CurrentSelection.AbsoluteName
    
    dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
    
    rem ----------------------------------------------------------------------
    dim args2(5) as new com.sun.star.beans.PropertyValue
    args2(0).Name = "Hyperlink.Text"
    args2(0).Value = linktext '"link"
    args2(1).Name = "Hyperlink.URL"
    args2(1).Value = "https://www.someurl.php?link=" & linktext
    args2(2).Name = "Hyperlink.Target"
    args2(2).Value = ""
    args2(3).Name = "Hyperlink.Name"
    args2(3).Value = ""
    args2(4).Name = "Hyperlink.Type"
    args2(4).Value = 1
    args2(5).Name = "Hyperlink.ReplacementText"
    args2(5).Value = ""
    
    dispatcher.executeDispatch(document, ".uno:SetHyperlink", "", 0, args2())
    
    'Don't know how to now append text without deleting the hyperlink

end sub

我尝试将单元格内容获取为值和字符串等，但似乎没有任何效果。

Answer 1

此答案是根据 Lupp 在 Ask LibreOffice 社区站点中的答案修改的，该答案基于 Andew Pitonyak 的“有用的宏信息”，第 5.18.5 子章。显然，URL 和单独的文本存储为单元格内的枚举字段。

无论单元格内有 0、1、2 还是更多单词，代码都应该有效。 如果有 0 个单词，Sub 将直接退出。如果有1个单词，则会在末尾添加一个额外的空格。如果您没有这个，那么您可以添加更多代码来防止这种情况发生。第二个及之后的单词将简单地插入到 URL 单词后面。

Sub InsertURLIntoCell
  Dim oText   'Text object for the current object
  Dim oField  'Field to insert
  Dim oCell   'Get a specific cell
  Dim aTexts()  ' Array of texts in the field
  Dim iUBound as Integer
  
  oCell = ThisComponent.CurrentSelection

  REM Create a URL Text field
  oField = ThisComponent.createInstance("com.sun.star.text.TextField.URL")

  REM This is the actual text that is displayed for the URL
  
  aTexts = Split(oCell.getString(), " ", 2)
  iUBound = UBound(aTexts)
  If (iUBound = -1) Then
    ' There are no strings in the field... just quit
    Exit Sub
  ElseIf (iUBound = 0) Then
    ' There is only 1 string, set 2nd string to blank
    ReDim Preserve aTexts(1)
    aTexts(1) = ""
  End If
     
  oField.Representation = aTexts(0)
  
  REM The URL property is just a text string of the URL itself.
  'oField.URL = ConvertToURL(oCell.getString())
  oField.URL = ConvertToURL("https://www.someurl.php?link=" & aTexts(0))
  
  REM The text field is added as text content into the cell.
  REM If you do not now set the string to zero, then the existing
  REM text will remain and the new URL text field will be appended
  REM to the end.
  oCell.setString("")
  oText = oCell.getText()
  oText.insertTextContent(oText.createTextCursor(), oField, False)
  oText.insertString(oText.getEnd(), " " & aTexts(1), False)  
End Sub