I have searched a moment here or there. But it is not synthesized in one post, so a bit bad indexed by the usual search engines.
The last demonstration is funny to use it with a lot of shortcuts between Writer and a Web browser:
- Be in a Writer a type a text as usually. Select several words, for example with a shortcut like [Crtl] + [Shift] + [←] or [Crtl] + [Shift] + [→].
- Switch on a Web Browser with the shortcut [Alt] + [Tab].
- Call the URL text field with the shortcut [Crtl] + [L]. As usual, the URL is yet selected.
- Copy the URL in the clipboard with the shortcut [Crtl] + [C] or [Crtl] + [Ins].
- Return on Writer with the shortcut [Alt] + [Tab].
- Call the shortcut for the macro clipBboardToHyperlinkOnSelection() set in Writer like [Crtl] + [Shift] + [K].
Code: Select all
' ╔══════════════════════════════════════════════════════════════════════════════╗
' ║ COPY a text string TO the clipboard. ║█
' ╚══════════════════════════════════════════════════════════════════════════════╝█
' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
Global clipString As String
Sub stringInTheClipboard()
Dim cBoard As Object, cTrans As Object, null As Object
cBoard = createUnoService ( "com.sun.star.datatransfer.clipboard.SystemClipboard")
cTrans = createUnoListener("TR_", "com.sun.star.datatransfer.XTransferable" )
cBoard.setContents(cTrans, null)
End Sub
Function TR_getTransferData(aFlavor as com.sun.star.datatransfer.DataFlavor )
If (aFlavor.MimeType = "text/plain;charset=utf-16") Then TR_getTransferData = clipString
End Function
Function TR_getTransferDataFlavors()
Dim aF as new com.sun.star.datatransfer.DataFlavor
aF.MimeType = "text/plain;charset=utf-16"
aF.HumanPresentableName = "Unicode-Text"
TR_getTransferDataFlavors = Array(aF)
End Function
Function TR_isDataFlavorSupported(aFlavor as com.sun.star.datatransfer.DataFlavor) as Boolean
TR_isDataFlavorSupported = (aFlavor.MimeType = "text/plain;charset=utf-16")
End Function
' ╔══════════════════════════════════════════════════════════════════════════════╗
' ║ PASTE a text string FROM the clipboard. ║█
' ╚══════════════════════════════════════════════════════════════════════════════╝█
' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
Function getClipboardText() As String
Dim oClip As Object, oConverter As Object
Dim oClipContents As Object, oTypes As Object
Dim i%
On Error Resume Next
oClip = createUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
oConverter = createUnoService("com.sun.star.script.Converter")
oClipContents = oClip.getContents
oTypes = oClipContents.getTransferDataFlavors
For i = LBound(oTypes) To UBound(oTypes)
If oTypes(i).MimeType = "text/plain;charset=utf-16" Then Exit For
Next i
If (i >= 0) Then
On Error Resume Next
getClipboardText = oConverter.convertToSimpleType _
(oClipContents.getTransferData(oTypes(i)), com.sun.star.uno.TypeClass.STRING)
End If
End Function
' ╔══════════════════════════════════════════════════════════════════════════════╗
' ║ Demonstration of the two preceding procedures. ║█
' ╚══════════════════════════════════════════════════════════════════════════════╝█
' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
' Copy.
Sub callStringInTheClipboard()
clipString = "A green mouse running in the grass"
stringInTheClipboard()
End Sub
' Paste.
Sub callGetClipboardText()
msgBox (getClipboardText(), 64, "TEXTUAL content of the clipboard")
End Sub
' ╔══════════════════════════════════════════════════════════════════════════════╗
' ║ Practical demonstration in Writer. ║█
' ╚══════════════════════════════════════════════════════════════════════════════╝█
' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
Sub clipBboardToHyperlinkOnSelection()
Dim myText As Object, myURL As String
myText = thisComponent.currentSelection(0)
If myText.String = "" Then
msgBox("Please, do a selection of text.", 16, "No selection.")
Exit Sub
End If
myURL = getClipboardText()
If (left(myURL, 6) <> "ftp://" ) And _
(left(myURL, 7) <> "http://" ) And _
(left(myURL, 8) <> "https://") Then
msgBox("The clipboard do not contain a right URL.", 16, "Bad contain.")
Exit Sub
End If
' myText.hyperLinkName = ""
myText.hyperLinkTarget = "_blank"
myText.hyperLinkURL = getClipboardText()
End sub