OpenOffice.org Forum at OOoForum.orgThe OpenOffice.org Forum
 
 [Home]   [FAQ]   [Search]   [Memberlist]   [Usergroups]   [Register
 [Profile]   [Log in to check your private messages]   [Log in

[Calc] Copy visible ranges only

 
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Code Snippets
View previous topic :: View next topic  
Author Message
Villeroy
Super User
Super User


Joined: 04 Oct 2004
Posts: 10106
Location: Germany

PostPosted: Thu Jun 29, 2006 3:09 pm    Post subject: [Calc] Copy visible ranges only Reply with quote

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 https://forum.openoffice.org


Last edited by Villeroy on Sat Mar 16, 2013 1:20 am; edited 7 times in total
Back to top
View user's profile Send private message
noranthon
Super User
Super User


Joined: 07 Jul 2005
Posts: 3318

PostPosted: Fri Apr 27, 2007 1:45 am    Post subject: Reply with quote

The second line beginning with "If" in the last function may need a minor amendment after pasting to your Basic editor: http://www.oooforum.org/forum/viewtopic.phtml?p=222264#222264
_________________
search forum by month
Back to top
View user's profile Send private message
Chi Sin Wolf
General User
General User


Joined: 26 Apr 2007
Posts: 5

PostPosted: Fri Apr 27, 2007 3:08 am    Post subject: Reply with quote

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
View user's profile Send private message
Villeroy
Super User
Super User


Joined: 04 Oct 2004
Posts: 10106
Location: Germany

PostPosted: Fri Apr 27, 2007 4:56 am    Post subject: Reply with quote

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 https://forum.openoffice.org
Back to top
View user's profile Send private message
Villeroy
Super User
Super User


Joined: 04 Oct 2004
Posts: 10106
Location: Germany

PostPosted: Sat May 05, 2012 1:47 pm    Post subject: Reply with quote

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 https://forum.openoffice.org
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    OOoForum.org Forum Index -> OpenOffice.org Code Snippets All times are GMT - 8 Hours
Page 1 of 1

 
Jump to:  
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