I always end up needing to open a grouped graphic in OOO Draw, and I always spend hours looking for how can I do it from Writer in single click, without opening Draw separately, and copy pasting stuff in it. So here is a BASIC macro which should do it (tested on Ubuntu 9.04 + OOO 3.0)
- Simply copy the code below in a new BASIC module, and enter the path to that module as Const MACRO_LOC (keep the dot at end)
- Then, for each document you open in Writer, you have to register the macro separately, by running its registerContextMenuInterceptor sub. (I couldn't figure out how to 'install' it for all Writer documents)
- Once its registered, whenever you right-click on a graphic or a group, you will get a context menu entry, "Open SvxShapeCollection in Draw"
- When you select that option, the graphics selection in Writer is grouped, Draw is automatically opened with a page size matching the Writer group (good for exporting), and the Writer group is pasted in Draw.
- A toolbar button is show in Draw to close and finish. Upon close from this button, you have the option of updating your originating Writer content with the one currently in Draw (which is possibly edited). (Upon updating the content, the Draw content is again re-grouped in a single group.)
) Well, hope someone can find this useful,
Cheers!
Code: Select all
REM ***** BASIC *****
REM FROM http://codesnippets.services.openoffice.org/Office/Office.ContexMenuInterceptor.snip?passthru=1?passthru=1?passthru=1
REM FOR ClipboardCopy, SelectAll YOU ALSO NEED UtilAPI module http://www.oooforum.org/forum/viewtopic.phtml?p=73054#73054
REM ***** BASIC *****
Option Explicit
Global oDocView As Object
Global oContextMenuInterceptor As Object
Global oStore As Object
Global oPropSetRegistry As Object
Global oSelection As Object
Global dDoc As Object
Global orDoc As Object
Global selGroupWriter As Object
Const MNU_PREFIX = "pmxMenu_"
Const MACRO_LOC = "Standard.MyModuleOpinDraw."
Sub reregisterContextMenuInterceptor
releaseContextMenuInterceptor
registerContextMenuInterceptor
End Sub
'_______________________________________________________________________________
Sub registerContextMenuInterceptor
InitMenuFactory
oDocView = ThisComponent.CurrentController
oContextMenuInterceptor = _
CreateUnoListener("ThisDocument_", "com.sun.star.ui.XContextMenuInterceptor")
oDocView.registerContextMenuInterceptor(oContextMenuInterceptor)
End Sub
'_______________________________________________________________________________
Sub releaseContextMenuInterceptor
On Error Resume Next
oDocView.releaseContextMenuInterceptor(oContextMenuInterceptor)
TerminateMenuFactory
End Sub
'_______________________________________________________________________________
Function ThisDocument_notifyContextMenuExecute(ContextMenuExecuteEvent As Object) As Variant
Dim oSrcWin As Object
Dim oExePoint As Object
Dim oATContainer As Object
' move to Global, we'll need it there; macros from the custom menu entry are called by
' a string URL, and hence we cannot pass a reference to oSelection to our click handler
'Dim oSelection As Object
Dim oMenuItem As Object
Dim I As Integer
BasicLibraries.loadLibrary("XrayTool")
With ContextMenuExecuteEvent
'contains the window where the context
'menu has been requested
oSrcWin = .SourceWindow
'contains the position the context menu
'will be executed at (css.awt.Point)
oExePoint = .ExecutePosition
'enables the access to the menu content.
'The implementing object has to support the
'service ActionTriggerContainer
oATContainer = .ActionTriggerContainer
'provides the current selection
'inside the source window
oSelection = .Selection
End With
'remove all menu entries:
'For I = oATContainer.Count - 1 To 0 Step -1
' oATContainer.removeByIndex(I)
'Next I
' react only on graphics objects / groups
'If (oSelection.Selection.ImplementationName = "com.sun.star.drawing.SvxShapeCollection") Then
' rather, check if SvxShapeCollection is InStr ImplementationName ... (last ', 0' - case sensitive)
Dim imnm As String
Dim imns As String
Dim cpos As Integer ' must be here, else crash on OOO 3.0/Ubuntu !
imnm = oSelection.Selection.ImplementationName
imns = "SvxShapeCollection"
cpos = InStr(1, imnm, imns, 1) ' at least startPos must be 1 !!
If cpos > 0 Then
'add some context menu entry
oMenuItem = GetSimpleMenuItem("Entry1", "Open "+imns+" in Draw", "macro:///"+MACRO_LOC+"openDrawClickHandler")
oATContainer.insertByIndex(0, oMenuItem)
'xray oSelection
'oMenuItem = GetMenuSeparator("Entry2") ' separator, so it will not accept other arguments
'oMenuItem = GetSimpleMenuItem("Entry2", oSelection.Selection.ImplementationName, "")
'oATContainer.insertByIndex(1, oMenuItem)
'oMenuItem = GetSimpleMenuItem("Entry3", "Run the Snippet Creator", "macro:///SnippetCreator.Main.Main")
'oATContainer.insertByIndex(2, oMenuItem)
End If
' POSSIBLE RESULTS FOR THIS FUNCTION
' This function must result one of the following values:
' com.sun.star.ui.ContextMenuInterceptorAction.IGNORED
' the XContextMenuInterceptor has ignored the call.
' The next registered XContextMenuInterceptor should be notified.
' com.sun.star.ui.ContextMenuInterceptorAction.CANCELLED
' the context menu must not be executed.
' The next registered XContextMenuInterceptor should not be notified.
' com.sun.star.ui.ContextMenuInterceptorAction.EXECUTE_MODIFIED
' the menu has been modified and should be executed
' without notifying the next registered XContextMenuInterceptor.
' com.sun.star.ui.ContextMenuInterceptorAction.CONTINUE_MODIFIED
' the menu has been modified and the next registered
' XContextMenuInterceptor should be notified.
ThisDocument_notifyContextMenuExecute = _
com.sun.star.ui.ContextMenuInterceptorAction.EXECUTE_MODIFIED
End Function
'_______________________________________________________________________________
' MENU FACTORY ROUTINES
'_______________________________________________________________________________
Sub InitMenuFactory()
oStore = CreateUnoService("com.sun.star.ucb.Store")
oPropSetRegistry = oStore.createPropertySetRegistry("")
End Sub
'_______________________________________________________________________________
Sub TerminateMenuFactory()
Dim mNames()
Dim sName As String
Dim I As Integer
mNames() = oPropSetRegistry.getElementNames
For I = LBound(mNames()) To UBound(mNames())
sName = mNames(I)
If Left(sName, Len(MNU_PREFIX)) = MNU_PREFIX Then
oPropSetRegistry.removePropertySet ( sName )
End If
Next I
oPropSetRegistry.dispose
oStore.dispose
End Sub
'_______________________________________________________________________________
' Sorry: menu icon and sub-menues not supported
Function GetSimpleMenuItem( sName As String, sText As String, _
sCommandUrl As String, Optional sHelpUrl As String ) As Object
Dim oPropSet As Object
Dim sInternalName As String
sInternalName = MNU_PREFIX & sName
If oPropSetRegistry.hasByName(sInternalName) Then
oPropSetRegistry.removePropertySet(sInternalName)
End If
oPropSet = oPropSetRegistry.openPropertySet(sInternalName, True)
oPropSet.addProperty("Text", 0, sText)
oPropSet.addProperty("CommandURL", 0, sCommandUrl)
If Not IsMissing(sHelpUrl) Then
oPropSet.addProperty("HelpURL", 0, sHelpUrl)
End If
GetSimpleMenuItem = oPropSet
End Function
'_______________________________________________________________________________
Function GetMenuSeparator( sName As String ) As Object
Dim oPropSet As Object
Dim sInternalName As String
Dim iSeparatorType As Integer
sInternalName = MNU_PREFIX & sName
If oPropSetRegistry.hasByName(sInternalName) Then
oPropSetRegistry.removePropertySet(sInternalName)
End If
oPropSet = oPropSetRegistry.openPropertySet(sInternalName, True)
'constant group com.sun.star.ui.ActionTriggerSeparatorType not supported?
'unfortunately, the only separator-type working is the "SPACE"
'regardless for the iSeparatorType passed...
iSeparatorType = 1
oPropSet.addProperty("SeparatorType", 0, iSeparatorType)
GetMenuSeparator = oPropSet
End Function
'_______________________________________________________________________________
' CLICK HANDLER
'_______________________________________________________________________________
Sub openDrawClickHandler()
' msgbox("openDrawClickHandler! " + oSelection.Selection.ImplementationName)
' xray oSelection
' OK, right-click has been clicked - over a graphics/group selection, and we have the selection
' copy selection, open Draw, paste the selection there.
' first global link to ThisComponent - the originating Writer document
orDoc = ThisComponent
' ClipboardCopy argument refers to Doc = ThisComponent, and thus
' automatically the selection there? but can we try to put link to selection instead?
ClipboardCopy( orDoc )
' find size of selection group; ' サービス名を取得しているとバージョンによって値が変化するので好ましくない。
' http://hermione.s41.xrea.com/pukiwiki/pukiwiki.php?OOobbs%2F50
' see also there for how to check for shapes in different OOO versions
Dim selShapes
Dim selPage
' Dim selGroup ' need it global, selGroupWriter
Dim selW
Dim selH
selShapes = orDoc.getCurrentSelection()
selPage = orDoc.CurrentController.Model.getDrawPage()
' autogroup, if not grouped already
if selShapes.Count = 1 then '--> １つの時はグループ化しない。(主として Writer への対応措置）
selGroupWriter = selShapes.getByIndex(0)
else
' 選択されたオブジェクトをグループ化
selGroupWriter = selPage.group(selShapes)
end if
' 選択されたオブジェクトの情報表示
selW = selGroupWriter.Size.Width
selH = selGroupWriter.Size.Height
' open Draw
'Dim dDoc ' must have this in Ubuntu! else "variable not defined" trouble.. - need it global
dDoc = StarDesktop.loadComponentFromURL( "private:factory/sdraw", "_blank", 0, Array() )
'xray dDoc
' first make the page size of the draw doc match the selection
' http://www.pitonyak.org/AndrewMacro.pdf
'dFrame = dDoc.getCurrentController().Frame
'dFramePosSize = dFrame.getComponentWindow.PosSize
''dWindowHeight = dFramePosSize.Height
''dWindowWidth = dFramePosSize.Width
' http://hektor.umcs.lublin.pl/~mikosmul/computing/articles/openoffice-macros.html
'Dim oStyle
'oStyle = dDoc.StyleFamilies.getByName("PageStyles").getByName("Default")
' units of 1/1000 cm : 21000 + 29700
'oStyle.Width = 2100
'oStyle.Height = 2970
' this works to control the page size..
dDoc.CurrentController.CurrentPage.Width = selW
dDoc.CurrentController.CurrentPage.Height = selH
' show the 'special' close button for returning to Writer
initToolbar( dDoc )
ClipboardPaste( dDoc )
End Sub
'_______________________________________________________________________________
' TOOLBARS
'_______________________________________________________________________________
' http://user.services.openoffice.org/en/forum/viewtopic.php?f=21&t=4352
' http://www.mail-archive.com/dev@api.openoffice.org/msg04779.html
'define the strings we need - global, too
Global toolbarResourceUrl, toolbarUIName, itemLabel, itemCommandUrl, itemService
'http://www.oooforum.org/forum/viewtopic.phtml?t=47503&p=287453
'const ResourceURL = "private:resource/toolbar/ms777_23"
'const sUnoUrl = ".uno:CommandLineToolbar"
'const sService = "ms777.ToolbarCombobox"
'const sToolbarUIName = "ms777_23"
sub initToolbar(ByRef innDoc)
toolbarResourceUrl = "private:resource/toolbar/custom_toolbar_opindraw"
toolbarUIName = "Close button for Draw" ' "custom_toolbar_opindraw"
itemLabel = "Close and back to Writer" ' "closeDrawClickHandler"
'itemCommandUrl = "macro:///"+MACRO_LOC+"closeDrawClickHandler" ' works too... with () on end or not
'itemCommandUrl = ".uno:CommandLineToolbar"
'itemCommandUrl = ".uno:OpenUrl" ' shows a dropdown
'itemCommandUrl = ".uno:Open" ' shows the filo open icon
itemCommandUrl = "vnd.sun.star.script:"+MACRO_LOC+"closeDrawClickHandler?language=Basic&location=application"
' not using this here
'itemCommandUrl = ".uno:opindrawCombobox"
'itemService = "opindraw.Toolbar" ' "opindraw.ToolbarCombobox"
createToolbar(innDoc, toolbarResourceUrl, toolbarUIName, itemLabel, itemCommandUrl, itemService)
'createToolbar2() ' doesn't show ... most of the time...
end sub
sub createToolbar(ByRef inDoc, toolbarResourceUrl as String, toolbarUIName as String, itemLabel as String, _
itemCommandUrl as String, itemService as String)
'I heavily borrowed from Peter http://www.oooforum.org/forum/viewtopic.phtml?t=50877 when writing this
'register the itemService at the Toolbarfactory
Dim oo, oLM, oEL, oToolbarSettings, cDockArea
' THIS is a portion of the orig code that needs a service (http://user.services.openoffice.org/en/forum/viewtopic.php?f=21&t=4351)
' and that method uses extra beanshell
' but, if it is executed here without the beanshell, it screws the clicks !!
'oo = createUnoService("com.sun.star.frame.ToolBarControllerFactory")
'if oo.hasController( itemCommandUrl, "") then oo.deregisterController( itemCommandUrl, "")
'oo.registerController( itemCommandUrl, "", itemService)
'delete toolbar if existing
oLM = inDoc.CurrentController.Frame.Layoutmanager
if not IsNull(oLM.getElement(toolbarResourceUrl)) then oLM.destroyElement(toolbarResourceUrl)
'create toolbar
oLM.createElement(toolbarResourceUrl)
'insert one component into toolbar and set the UIName
oEL = oLM.getElement(toolbarResourceUrl)
oToolbarSettings = oEL.getSettings(true)
Dim srep as String
Dim x, xx, xxx
Dim aItem
aItem = CreateToolbarItem( itemCommandUrl, itemLabel )
oToolbarSettings.insertByIndex( 0, aItem )
oToolbarSettings.UIName = toolbarUIName
oEL.setSettings(oToolbarSettings)
'oEL.updateSettings
oLM.showElement(toolbarResourceUrl)
REM old: make sure that the toolbar is docked in a separate new line in the docking area
'cDockArea = com.sun.star.ui.DockingArea.DOCKINGAREA_TOP
'Dim aPos as New com.sun.star.awt.Point
'aPos.X = 0
'aPos.Y = 0
'oLM.dockWindow(toolbarResourceUrl,cDockArea,aPos)
REM here we want float instead:
oLM.floatWindow(toolbarResourceUrl)
end sub
Function CreateToolbarItem( Command as String, Label as String ) as Variant
Dim aToolbarItem(4) as new com.sun.star.beans.PropertyValue
' older attempts:
'Dim aItem(1) as new com.sun.star.beans.PropertyValue
'aItem(0).Name = "CommandURL"
'aItem(0).Value = itemCommandUrl
'aItem(1).Name = "Label"
'aItem(1).Value = itemLabel
'aToolbarItem(0).Name = "CommandURL"
'aToolbarItem(0).Value = Command
'aToolbarItem(1).Name = "Label"
'aToolbarItem(1).Value = Label
'aToolbarItem(2).Name = "Type"
'aToolbarItem(2).Value = 0 ' must be 0 to get a button..
'aToolbarItem(3).Name = "Visible"
'aToolbarItem(3).Value = true
aToolbarItem(0).Name = "CommandURL"
aToolbarItem(0).Value = Command
aToolbarItem(1).Name = "Type"
aToolbarItem(1).Value = 0 ' must be 0 to get a button..
aToolbarItem(2).Name = "Label"
aToolbarItem(2).Value = Label
aToolbarItem(3).Name = "HelpURL"
aToolbarItem(3).Value = Command
aToolbarItem(4).Name = "IsVisible"
aToolbarItem(4).Value = true
CreateToolbarItem = aToolbarItem()
End Function
'_______________________________________________________________________________
' RETURN FROM DRAW
'_______________________________________________________________________________
sub closeDrawClickHandler()
'msgbox("closeDrawClickHandler !! " + dDoc.CurrentController.CurrentPage.Width)
dim mret
mret = MsgBox ("About to close Draw. Would you like to update originating content in Writer with the changes made in Draw?", MB_YESNO + MB_DEFBUTTON2 + MB_ICONQUESTION)
If mret = IDYES Then
'msgbox("YES closeDrawClickHandler !! " + dDoc.CurrentController.CurrentPage.Width)
' select all in dDoc
SelectAll(dDoc)
' same trick as above to regroup
Dim selShapes, selGroup, selPage
selShapes = dDoc.getCurrentSelection()
selPage = dDoc.CurrentController.getCurrentPage()
' autogroup, if not grouped already
if selShapes.Count = 1 then
selGroup = selShapes.getByIndex(0)
else
selGroup = selPage.group(selShapes)
end if
' we have selGroupWriter which should be replaced..
' so cut it here, so cursor remains in position in orDoc;
' the cut contents will be overwritten by the next copy
ClipboardCut( orDoc )
' ClipboardCopy argument refers to Doc = ThisComponent, and thus
' automatically the selection there?
SelectAll(dDoc) ' again, for new group
ClipboardCopy( dDoc )
' finally paste in orDoc
ClipboardPaste( orDoc )
'Else
'msgbox("NO closeDrawClickHandler !! " + dDoc.CurrentController.CurrentPage.Width)
' do nothing
End If
dDoc.close(true) ' bForce, so we're not prompted to save
end sub
REM ' small debug
REM For Each x in oLM.getElements()
REM Dim ots
REM ots = x.getSettings(true)
REM Dim otsc, otscl
REM On Error Resume Next
REM otscl = LBound(ots) ' no work?
REM For xx = 0 to ots.getCount()-1
REM otsc = ots.getByIndex( xx )
REM 'Dim otsco
REM Dim ogc
REM On Error Resume Next
REM 'otsco = otsc(0) ' CommandURL
REM srep = srep & xx & CHR$(10)
REM ogc = LBound(otsc)
REM For xxx = ogc to UBound(otsc)
REM srep = srep & xx & " " & otsc(xxx).Name & " " & otsc(xxx).Value & CHR$(10)
REM Next
REM Next
REM srep = srep & " ******** " & CHR$(10) & " ******** " & x.ResourceURL & " " & ots.UIName & CHR$(10)
REM 'xray ots
REM Next
REM 'msgbox srep
REM 'TextToClipboard(srep)
REM ThisComponent.getText().insertString( ThisComponent.getText().createTextCursor(), srep, False )
' couldn't get createToolbar2 to work..
sub createToolbar2()
Dim oModuleCfgMgrSupplier, oWindowState, oModuleCfgMgr, oBasicWindowState, oToolbarItem, oToolbarSettings
Dim oLM
REM *** Retrieve the module configuration manager from central module configuration manager supplier
oModuleCfgMgrSupplier = createUnoService("com.sun.star.ui.ModuleUIConfigurationManagerSupplier")
'oWindowState = createUnoService("com.sun.star.ui.WindowStateConfiguration")
REM *** Retrieve the module configuration manager with the module identifier
REM *** See com.sun.star.frame.ModuleManager for more information
'oModuleCfgMgr = oModuleCfgMgrSupplier.getUIConfigurationManager( "com.sun.star.script.BasicIDE" )
'oModuleCfgMgr = oModuleCfgMgrSupplier.getUIConfigurationManager( ThisComponent ) 'NO
'oModuleCfgMgr = ThisComponent.getUIConfigurationManager()
oModuleCfgMgr = oModuleCfgMgrSupplier.getUIConfigurationManager( "com.sun.star.text.TextDocument" )
REM *** Retrieve the window state configuration for the Basic IDE
' oBasicWindowState = oWindowState.getByName( sBasicIDEModuleIdentifier )
REM *** Create a settings container which will define the structure of our new
REM *** custom toolbar.
oToolbarSettings = oModuleCfgMgr.createSettings()
REM *** Set a title for our new custom toolbar
oToolbarSettings.UIName = toolbarUIName
REM *** Create a button for our new custom toolbar
oToolbarItem = CreateToolbarItem( itemCommandUrl, itemLabel )
oToolbarSettings.insertByIndex( 0, oToolbarItem )
REM *** Set the settings for our new custom toolbar. (replace/insert)
if ( oModuleCfgMgr.hasSettings( toolbarResourceUrl )) then
oModuleCfgMgr.replaceSettings( toolbarResourceUrl, oToolbarSettings )
else
oModuleCfgMgr.insertSettings( toolbarResourceUrl, oToolbarSettings )
endif
oLM = ThisComponent.CurrentController.Frame.Layoutmanager
oLM.showElement(toolbarResourceUrl)
oLM.floatWindow(toolbarResourceUrl)
end sub