<?xml version="1.0"?> <snippet language="OOBasic" application="Calc">
<keywords> <keyword>sort</keyword> <keyword>sorting</keyword> </keywords> <authors> <author id="swubuntu" initial="true" email="[EMAIL PROTECTED]">Stefan Weigel</author> </authors> <question heading="Improve sorting capabilities"> </question> <answer> <p>This macro provides an improved sorting function for the user.</p> <p></p> <p>It enables to sort using as many sort criteria as desired. (Calc normally allows max. 3 criteria.)</p> <p></p> <p>The sort criteria to be used is determined by the currently active cell. (Calc normally uses the first column.)</p> <p></p> <p>The macro recognizes if there are column headers (Calc normally does not recognize column header when using the sort icons from the toolbar)</p> <p></p> <p>The macro overcomes issue #7277 and issue #20491. For background info and long description see http://www.stefan-weigel.de/?ID=83. For German text see http://www.stefan-weigel.de/?ID=81</p> <listing>REM ***** BASIC ***** option explicit sub SWsortUp() thisComponent.lockcontrollers SWSort true thisComponent.unlockcontrollers end sub sub SWsortDown() thisComponent.lockcontrollers SWSort false thisComponent.unlockcontrollers end sub sub SWsort(blnUpDown) Dim oSheet ' Betroffenes Tabellenblatt Dim oListe as Object ' Zu sortierender Bereich Dim intListeStartSpalte ' Dim intListeEndSpalte ' Dim lngListeStartZeile ' Dim lngListeEndZeile ' Dim intListeAnzSpalten ' Dim lngListeAnzZeilen ' Dim intKritSpalte as Integer ' Nummer der Spalte, nach der sortiert werden soll Dim blnUeberschriften ' Hat die Liste Überschriften? Dim i as Integer ' Laufvariable Integer Dim oRange as Object ' Hilfsvariable für Zellbereich Dim aSortFields(1) as New [EMAIL PROTECTED] com.sun.star.table.TableSortField} Dim aSortDesc(1) as New [EMAIL PROTECTED] com.sun.star.beans.PropertyValue} 'Betroffenes Tabellenblatt oSheet = ThisComponent.CurrentController.ActiveSheet ' Was der User markiert hat oListe = thisComponent.CurrentSelection ' Es dürfen nicht mehrere Bereiche markiert sein if oListe.supportsService("[EMAIL PROTECTED] com.sun.star.sheet.SheetCellRanges}") then msgbox "Sortieren in mehreren Bereichen nicht möglich!",,"© Ingenieurbüro Weigel" exit sub end if 'Feststellen der Spalte der aktiven Zelle oRange = thisComponent.createInstance("[EMAIL PROTECTED] com.sun.star.sheet.SheetCellRanges}") ThisComponent.CurrentController.Select(oRange) intKritSpalte = ThisComponent.CurrentSelection.getCellAddress.Column ThisComponent.CurrentController.Select(oListe) 'Markieren des Listenbereichs, wenn genau eine einzelne Zelle markiert ist '(Trick: verwende die Erkennung die Calc beim Sortieren durchführt) SelectCurrentRange 'Zeilen und Spalten des zu sortierenden Bereichs intListeStartSpalte = ThisComponent.CurrentSelection.getRangeAddress.StartColumn intListeEndSpalte = ThisComponent.CurrentSelection.getRangeAddress.EndColumn intListeAnzSpalten = intListeEndSpalte - intListeStartSpalte lngListeStartZeile = ThisComponent.CurrentSelection.getRangeAddress.StartRow lngListeEndZeile = ThisComponent.CurrentSelection.getRangeAddress.EndRow lngListeAnzZeilen = lngListeEndZeile - lngListeStartZeile + 1 'Nummer der Sortierspalte innerhalb des zu sortierenden Bereichs intKritSpalte = intKritSpalte - intListeStartSpalte if lngListeAnzZeilen = 1 then exit sub 'Überschriften? blnUeberschriften = false 'Die erste Zeile wird als Überschrift interpretiert, wenn die Zellen der ersten und zweiten Zeile unterschiedlich Datentypen enthalten for i=intListeStartSpalte to intListeEndSpalte if oSheet.getCellByPosition(i,lngListeStartZeile).FormulaResultType <> oSheet.getCellByPosition(i,lngListeStartZeile+1).FormulaResultType and _ oSheet.getCellByPosition(i,lngListeStartZeile).FormulaResultType <> 0 and _ oSheet.getCellByPosition(i,lngListeStartZeile+1).FormulaResultType <> 0 then blnUeberschriften = true exit for end if next i if blnUeberschriften = false then 'Die erste Zeile wird auch dann als Überschrift interpretiert, 'wenn die Zellen der ersten und zweiten Zeile zwar gleiche Datentypen enthalten, aber unterschiedliche Formatvorlagen verwenden for i=intListeStartSpalte to intListeEndSpalte if oSheet.getCellByPosition(i,lngListeStartZeile).CellStyle <> oSheet.getCellByPosition(i,lngListeStartZeile+1).CellStyle then blnUeberschriften = true exit for end if next i end if If blnUeberschriften and lngListeAnzZeilen > 1 then lngListeStartZeile = lngListeStartZeile + 1 lngListeAnzZeilen = lngListeAnzZeilen -1 end if if lngListeAnzZeilen = 1 then exit sub 'Hilfsspalte einfügen oSheet.Columns.insertByIndex(intListeEndSpalte+1,1) 'bisherige Ordnung in Hilfsspalte durchnummerieren 'for i=lngListeStartZeile to lngListeEndZeile ' oSheet.getCellByPosition(intListeEndSpalte+1,i).value=i 'next i 'Auf Anregung von Andreas Saeger ([EMAIL PROTECTED]) auf users@de.openoffice.org geht das Nummerieren so schneller: dim dA(), rA() with oSheet.getCellRangeByPosition(intListeEndSpalte+1,lngListeStartZeile,intListeEndSpalte+1,lngListeEndZeile) dA() = .getDataArray() for i = lBound(dA()) to uBound(dA()) rA() = dA(i) rA(0) = i next .setDataArray(dA()) End With oListe =oSheet.getCellRangeByPosition(intListeStartSpalte,lngListeStartZeile,intListeEndSpalte+1,lngListeEndZeile) 'Sortieren aSortFields(0).Field = intKritSpalte 'Spalte, in der der User die aktive Zelle gesetzt hatte aSortFields(0).IsAscending = blnUpDown aSortFields(0).IsCaseSensitive = false aSortFields(1).Field = intListeEndSpalte+1 'Hilfspalte mit bisheriger Ordnung aSortFields(1).IsAscending = true aSortFields(1).IsCaseSensitive = false aSortDesc(0).Name = "SortFields" aSortDesc(0).Value = aSortFields() aSortDesc(1).Name = "ContainsHeader" aSortDesc(1).Value = false oListe.sort(aSortDesc()) 'Hilfsspalte entfernen oSheet.Columns.removeByIndex(intListeEndSpalte+1,1) oListe =oSheet.getCellRangeByPosition(intListeStartSpalte,lngListeStartZeile,intListeEndSpalte,lngListeEndZeile) ThisComponent.CurrentController.Select(oListe) end sub sub SelectCurrentRange dim oDisp as object dim oDoc as object dim Array() oDoc = ThisComponent.CurrentController.Frame oDisp = createUnoService("[EMAIL PROTECTED] com.sun.star.frame.DispatchHelper}") oDisp.executeDispatch(oDoc, ".uno:SortAscending", "", 0, Array()) oDisp.executeDispatch(ThisComponent.CurrentController.Frame,".uno:Undo", "",0, Array()) End Sub </listing> </answer> <versions> <version number="2.0.x" status="tested"/> </versions> <operating-systems> <operating-system name="All"/> </operating-systems> <changelog> </changelog> </snippet>
--------------------------------------------------------------------- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
