| View previous topic :: View next topic |
| Author |
Message |
Villeroy
Super User
Joined: 04 Oct 2004
Posts: 10065
Location: Germany
|
 Posted: Thu Jun 29, 2006 3:09 pm Post subject: [Calc] Copy visible ranges only |
 |
|
EDIT 2013-03-16: Since OOo 3.x This does not work anymore with a filtered range. Since OOo 3.x we can copy a filtered range without the help of this macro. The application splits up a single selection on a filtered range into a collection of visible ranges. Nevertheless, this macro may be still useful for demo purposes and with a selection on a single range with hidden rows and columns it still works as intended. Function getRangeSelection remains useful for many purposes.
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.
EDIT 2012-05-04 Adjusted one line to new requirements. See below posting for details.
EDIT 2013-03-12 Added one parameter bSingleCell. The SingleCellMode did not exist in the API at the time of writing.
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,bSingle as Boolean)
On error goto returnEmpty
Dim oListener,aProps(3) 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
aProps(3).Name = "SingleCellMode"
aProps(3).Value = bSingle
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")OR _
oSelect.supportsService("com.sun.star.sheet.SheetCellRanges") 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,bSingle:=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
|
_________________
Rest in peace, oooforum.org
Get help on http://forum.openoffice.org
Last edited by Villeroy on Sat Mar 16, 2013 1:20 am; edited 7 times in total |
|
| Back to top |
|
 |
noranthon
Super User
Joined: 07 Jul 2005
Posts: 3318
|
|
| 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: 10065
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.
_________________
Rest in peace, oooforum.org
Get help on http://forum.openoffice.org |
|
| Back to top |
|
|
Villeroy
Super User
Joined: 04 Oct 2004
Posts: 10065
Location: Germany
|
| Posted: Sat May 05, 2012 1:47 pm Post subject: |
|
|
Maintainance update:
OOo 3 or newer internally divides a filtered range into visible rows so you actually select multiple ranges when you select a rectangle of cells including filtered rows.
Since OOo3 we can copy&paste only visible cells from a filtered range and my original version of this macro exits with error message "Select a single range of spreadsheet cells, please".
Today I replaced ...
| Code: | | If oSelect.supportsService("com.sun.star.sheet.SheetCellRange") then |
... with ...
| Code: | If oSelect.supportsService("com.sun.star.sheet.SheetCellRange") OR _
oSelect.supportsService("com.sun.star.sheet.SheetCellRanges") then |
Intentionally I did not include the option to select multiple ranges. Now you can use it with arbitrary cell selections but if the shapes of the selected ranges differ too much you may get strange results in the target range with gaps or with overlapping ranges with data loss.
This is no problem if you use the modified macro like it was intended with a single rectangular selection cells.
_________________
Rest in peace, oooforum.org
Get help on http://forum.openoffice.org |
|
| 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
|
