What you are asking is similar to what I have done. I quickly gobbled this up from my macro library.
The following code copies text (selection, sentence or paragraph) to a text document. The formatting is preserved. The destination document is hard coded as nodes.odt
. Just create and save a blank document before you start. The text is pasted at the end of the document, in a new paragraph. For convenience I’ve added a routine to assign keyboard shortcuts to each of the copy subs. Change it to the keys of your liking and run it once to make the assignments. I would also recommend you put the source and destination documents side by side to make it less annoying since the code changes the active document back and forth each time it runs.
'
' Give VBA constants and other things to OO
'
Option Compatible
'Force variable decleration
Option Explicit
' Destination file
Const destFile As String ="file:///d:/temp/notes.odt"
Sub CopyText(opt as string)
' For path function later on...
GlobalScope.BasicLibraries.loadLibrary("Tools")
' This is the source/active document
Dim oDoc: oDoc = ThisComponent
' Open destination file
Dim notesDoc
if FileExists(destFile) then
notesDoc = stardesktop.loadComponentFromURL(destFile,"_default",0,array())
end if
'Refocus the doc we are editing
oDoc.CurrentController.Frame.ContainerWindow.toFront()
oDoc.CurrentController.Frame.Activate()
Dim oVCurs, oTCurs
oVCurs = oDoc.CurrentController.getViewCursor()
oTCurs = oDoc.Text.createTextCursorByRange(oVCurs)
select case opt
case "p"
oTCurs.gotoStartOfParagraph(false)
oTCurs.gotoEndOfParagraph(True)
case "s"
oTCurs.gotoStartOfSentence(false)
oTCurs.gotoEndOfSentence(True)
case "h"
oTCurs.gotoRange(oVCurs,true)
if oTCurs.getString() = "" then beep
case else
print "Error: Incorrent option provided. Exiting."
exit sub
end select
' Grab a copy
Dim oSrcCC
oSrcCC = ThisComponent.CurrentController
oSrcCC.Select(oTCurs)
Dim p: p = oSrcCC.getTransferable()
notesDoc.CurrentController.Frame.ContainerWindow.toFront()
notesDoc.CurrentController.Frame.Activate()
Dim oDstText
oDstText = notesDoc.Text
Dim oDstVCurs, oDstTCurs
oDstVCurs = notesDoc.CurrentController.getViewCursor()
oDstTCurs = notesDoc.Text.createTextCursor()
oDstTCurs.gotoEnd(false)
' Append a new paragraph at the end (stop next par from inhereting formating...)
oDstText.InsertControlCharacter(oDstTCurs,_
com.sun.star.text.ControlCharacter.APPEND_PARAGRAPH, False)
' Move cursor to position to insert text
oDstTCurs.gotoPreviousParagraph(false)
' Insert text (including formatting)
Dim oDstCC: oDstCC = notesDoc.CurrentController
oDstCC.select(oDstTCurs)
oDstCC.insertTransferable(p)
'Re-activate the source doc
oDoc.CurrentController.Frame.ContainerWindow.toFront()
oDoc.CurrentController.Frame.Activate()
End Sub
Sub CopyHighlightedText()
CopyText("h")
End Sub
Sub CopySentence()
CopyText("s")
End Sub
sub CopyParagraph()
CopyText("p")
end sub
'
' Windows Macros
'
Sub doSetKeyboardMacros()
Dim strCommandURL$, oKeyEvent
' Key list
' https://api.libreoffice.org/docs/idl/ref/awt_2Key_8idl.html
const CNTRL = 2
const SHIFT = 1
Const ALT = 4
' Ctrl+Shift+P: CopyParagraph()
strCommandURL = "vnd.sun.star.script:Standard.Module1.CopyParagraph?language=Basic&location=application"
oKeyEvent = CreateKeyEvent( CNTRL + SHIFT, com.sun.star.awt.Key.P)
SetCommandShortcut( oKeyEvent, strCommandURL )
' Ctrl+Shift+H: CopyHighlightedText()
strCommandURL = "vnd.sun.star.script:Standard.Module1.CopyHighlightedText?language=Basic&location=application"
oKeyEvent = CreateKeyEvent( CNTRL + SHIFT, com.sun.star.awt.Key.H)
SetCommandShortcut( oKeyEvent, strCommandURL )
' Ctrl-Shift-L: CopySentence()
strCommandURL = "vnd.sun.star.script:Standard.Module1.CopySentence?language=Basic&location=application"
oKeyEvent = CreateKeyEvent( CNTRL + SHIFT, com.sun.star.awt.Key.L)
SetCommandShortcut( oKeyEvent, strCommandURL )
end sub
Function getShortCutManager()
REM Return the ShortCutManager for the current Office Module.
Dim oModuleManager As Object, oModuleIdent
Dim oModuleConfigManager As Object, oModuleConfigManagerSupplier As Object
oModuleManager = createUnoService( "com.sun.star.frame.ModuleManager" )
oModuleIdent = oModuleManager.identify( ThisComponent )
oModuleConfigManagerSupplier = createUnoService( "com.sun.star.ui.ModuleUIConfigurationManagerSupplier" )
oModuleConfigManager = oModuleConfigManagerSupplier.getUIConfigurationManager( oModuleIdent )
getShortCutManager = oModuleConfigManager.getShortCutManager()
End Function
Sub SetCommandShortcut( oKeyEvent, strCommandURL as String )
REM Adapted from code by Paolo Mantovani.
REM Connects a Keyboard Shortcut to a certain Command, such as a macro or UNO dispatch.
REM <oKeyEvent>: com.sun.star.awt.KeyEvent representing the Keyboard Shortcut for this Command.
REM <strCommandURL>: the Command to which the Keyboard Shortcut will be attached.
REM Example call:
REM strCommandURL = "vnd.sun.star.script:Standard.Module1.Main?language=Basic&location=document"
REM oKeyEvent = CreateKeyEvent( 2, com.sun.star.awt.Key.J ) REM Ctrl-J
REM SetCommandShortcut( oKeyEvent, strCommandURL )
Dim oShortCutManager As Object
oShortCutManager = getShortCutManager()
oShortCutManager.setKeyEvent( oKeyEvent, strCommandURL )
oShortCutManager.store()
End Sub
Sub RemoveCommandShortcut( strCommandURL as String )
REM Removes all the Keyboard Shortcut(s) associated with the specified Command.
REM <strCommandURL>: a Command that has one or more Keyboard Shortcuts to be removed from it.
Dim oShortCutManager As Object
oShortCutManager = getShortCutManager()
oShortCutManager.removeCommandFromAllKeyEvents( strCommandURL )
oShortCutManager.store()
End Sub
Function CreateKeyEvent( iModifiers as Integer, iKeyCode as Integer ) As com.sun.star.awt.KeyEvent
REM Construct and return a KeyEvent structure.
Dim aKeyEvent As New com.sun.star.awt.KeyEvent
aKeyEvent.Modifiers = iModifiers
aKeyEvent.KeyCode = iKeyCode
CreateKeyEvent = aKeyEvent
End Function