| View previous topic :: View next topic |
| Author |
Message |
Villeroy
Super User
Joined: 04 Oct 2004
Posts: 7649
Location: Germany
|
 Posted: Thu Jun 29, 2006 3:09 pm Post subject: [Calc] Copy visible ranges only |
 |
|
Another request from the calc forum:
This is a quick macro and it behaves like this:
- Check for single range selection
- Query target-cell
- Split up a single range selection into visible tiles
- Copy first tile to target cell and append the other tiles seamless
It uses method copyCells of interface com.sun.star.sheet.XCellRangeMovement. This is equivalent to drag&drop within the same document. In particular it does not write anything into the clipboard.
It stops with a message if the target is not behind the source range on the same sheet (never write into source-selection) but it does not prevent overwriting any other contents.
Copy the following two code blocks into one or two modules and call "copyVisibleBlocksMerged"
EDIT 2006-06-30 Found some bug preventing copy of last element or one single element.
Generic code for getting a user selection:
| Code: |
Private sRangeSelection$,bRangeSelecting As Boolean
'return a valid com.sun.star.table.CellRangeAddress from a user's range-selection (or Empty)
Function getRangeSelectionAddress(oController,sInitial$,sTitle$,bAutoClose as Boolean)
On error goto returnEmpty
Dim oListener,aProps(2) As New com.sun.star.beans.PropertyValue
oListener = createUnoListener("RangeSelection_","com.sun.star.sheet.XRangeSelectionListener")
oController.addRangeSelectionListener(oListener)
aProps(0).Name = "InitialValue"
aProps(0).Value = sInitial
aProps(1).Name = "Title"
aProps(1).Value = sTitle
aProps(2).Name = "CloseOnMouseRelease"
aProps(2).Value = bAutoClose
With oController.getFrame
'this is required when calling from IDE or other frame in order to avoid endless loop
.activate
.getContainerWindow.toFront
End With
bRangeSelecting = True
oController.startRangeSelection(aProps())
while bRangeSelecting
wait 500
Wend
oController.removeRangeSelectionListener(oListener)
getRangeSelectionAddress = oController.getActiveSheet.getCellRangeByName(sRangeSelection).getRangeAddress
returnEmpty:
End Function
Sub RangeSelection_done(oEv)
sRangeSelection = oEv.RangeDescriptor
bRangeSelecting = false
End Sub
Sub RangeSelection_aborted(oEv)
sRangeSelection = ""
bRangeSelecting = false
End Sub
Sub RangeSelection_disposing(oEv)
End Sub
|
This performs the action
| Code: |
Sub copyVisibleBlocksMerged()
Dim oController,oSelect,oSheet,l&,last&,oAdr(),oNext,oSrc,oTgt,oBase
oController = ThisComponent.getCurrentController
oSelect = oController.getSelection
If oSelect.supportsService("com.sun.star.sheet.SheetCellRange") then
oBase = getTargetCellAddress(oController,oSelect)
If isUnoStruct(oBase) then
oSheet = thisComponent.getSheets.getByindex(oBase.Sheet)
oAdr() = oSelect.queryVisibleCells.getRangeAddresses()
if uBound(oAdr()) = -1 then exit sub
oTgt = oBase
last = uBound(oAdr())
oNext = oAdr(0) 'if there is only one range
For l = 0 to last -1
oSrc = oAdr(l)
oNext = oAdr(l +1)
oSheet.copyRange(oTgt,oSrc)
If oNext.StartRow < oSrc.StartRow then
oTgt.Column = oTgt.Column + oSrc.EndColumn - oSrc.StartColumn +1
oTgt.Row = oBase.Row
else
oTgt.Row = oTgt.Row + oSrc.EndRow - oSrc.StartRow +1
endif
next
oSheet.copyRange(oTgt,oNext) 'last range
endif
else
msgbox "Select a single range of spreadsheet cells, please",16,"exit macro: copyVisibleBlocksMerged"
endif
End Sub
Private Function getTargetCellAddress(oController,oRg)
Dim oRgAdr,oTgtRg,oCellAdr as new com.sun.star.table.CellAddress
oRgAdr = oRg.getRangeAddress
oTgtRg = getRangeSelectionAddress(oController,sInitial:="",sTitle:="Click Target Cell",bAutoClose:=True)
If isUnoStruct(oTgtRg) then
if (oTgtRg.Sheet <> oRgAdr.Sheet) OR (oTgtRg.StartRow > oRgAdr.EndRow) OR (oTgtRg.StartColumn > oRgAdr.EndColumn) then
oCellAdr.Sheet = oTgtRg.Sheet
oCellAdr.Row = oTgtRg.StartRow
oCellAdr.Column = oTgtRg.StartColumn
getTargetCellAddress = oCellAdr
else
msgbox "Target needs to be on another sheet or behind/below selection",16,"exit macro:getTargetCellAddress"
endif
endif
End Function
|
_________________
XUbuntu 9.04, OOo 3.1.1(Sun), Sun Java 1.5.0_06
Last edited by Villeroy on Fri Apr 27, 2007 4:50 am; edited 1 time in total |
|
| Back to top |
|
 |
noranthon
Super User
Joined: 07 Jul 2005
Posts: 3323
|
|
| Back to top |
|
|
Chi Sin Wolf
General User
Joined: 26 Apr 2007
Posts: 5
|
| Posted: Fri Apr 27, 2007 3:08 am Post subject: |
|
|
Actually, there were two areas where I had to delete a space after pasting. Sorry I didn't mention this before.
I imagine experienced people already know that if an underscore is at the end a line, it should be the final character i.e. no space. But I thought I'd flag this in case the not so experienced like me have a similar problem.
It's just that some times when copying and pasting, spaces can appear.
This fact is clearly mentioned in this forum in the "How to install a macro found here" section. http://www.oooforum.org/forum/viewtopic.phtml?t=7995
Thanks again for the help. This is an extremely helpful forum. |
|
| Back to top |
|
|
Villeroy
Super User
Joined: 04 Oct 2004
Posts: 7649
Location: Germany
|
| Posted: Fri Apr 27, 2007 4:56 am Post subject: |
|
|
I don't know why the forum's software adds spaces to line continuations. I removed all line continuations leaving some quite long lines. It seems as if a plain copy and paste will do now.
_________________
XUbuntu 9.04, OOo 3.1.1(Sun), Sun Java 1.5.0_06 |
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
