我有一个大型电子表格,希望自动执行将每个单元格的第一个单词转换为超链接的过程,但保持其余文本不变。 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
我尝试将单元格内容获取为值和字符串等,但似乎没有任何效果。
此答案是根据 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