This macro provides an improved sorting function for the user.
It enables to sort using as many sort criteria as desired. (Calc normally allows max. 3 criteria.)
The sort criteria to be used is determined by the currently active cell. (Calc normally uses the first column.)
The macro recognizes if there are column headers (Calc normally does not recognize column header when using the sort icons from the toolbar)
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
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 ' affected Calc-Sheet
Dim oList as Object ' area to sort
Dim intListStartColumn '
Dim intListEndColumn '
Dim lngListStartRow '
Dim lngListEndRow '
Dim intListCountColumnn '
Dim lngListCountRown '
Dim intCriteriaColumn as Integer ' number of column which defines the sort
Dim blnShowHeader ' should the list contain headers
Dim i as Integer ' helper var used as counter
Dim oRange as Object ' helper var for cell-range
Dim aSortFields(1) as New {@see com.sun.star.table.TableSortField}
Dim aSortDesc(1) as New {@see com.sun.star.beans.PropertyValue}
'affected Calc-Sheet
oSheet = ThisComponent.CurrentController.ActiveSheet
' Area selected by the user
oList = thisComponent.CurrentSelection
' check that only one are is selected
if oList.supportsService("{@see com.sun.star.sheet.SheetCellRanges}") then
msgbox "It's not allowed to sort more than one cell-range!",,"© Ingenieurbüro Weigel"
exit sub
end if
'Find the column with the active cell
oRange = thisComponent.createInstance("{@see com.sun.star.sheet.SheetCellRanges}")
ThisComponent.CurrentController.Select(oRange)
intCriteriaColumn = ThisComponent.CurrentSelection.getCellAddress.Column
ThisComponent.CurrentController.Select(oList)
'Mark the listarea if exactly one cell is selected
'(magic: use exact same algorythm used by calc when it sorts)
SelectCurrentRange
'rows and columns of sort area
intListStartColumn = ThisComponent.CurrentSelection.getRangeAddress.StartColumn
intListEndColumn = ThisComponent.CurrentSelection.getRangeAddress.EndColumn
intListCountColumnn = intListEndColumn - intListStartColumn
lngListStartRow = ThisComponent.CurrentSelection.getRangeAddress.StartRow
lngListEndRow = ThisComponent.CurrentSelection.getRangeAddress.EndRow
lngListCountRown = lngListEndRow - lngListStartRow + 1
'number of the of sort-column inside the sort area
intCriteriaColumn = intCriteriaColumn - intListStartColumn
if lngListCountRown = 1 then exit sub
'Headers?
blnShowHeader = false
'The first row is interpreted as headline if the datatypes of the cells in the first and second row differ
for i=intListStartColumn to intListEndColumn
if oSheet.getCellByPosition(i,lngListStartRow).FormulaResultType <> oSheet.getCellByPosition(i,lngListStartRow+1).FormulaResultType and _
oSheet.getCellByPosition(i,lngListStartRow).FormulaResultType <> 0 and _
oSheet.getCellByPosition(i,lngListStartRow+1).FormulaResultType <> 0 then
blnShowHeader = true
exit for
end if
next i
if blnShowHeader = false then
'The first row is also interpreted as headline
'if the datatypes of the cells in first and second row are equal but there are different formats used
for i=intListStartColumn to intListEndColumn
if oSheet.getCellByPosition(i,lngListStartRow).CellStyle <> oSheet.getCellByPosition(i,lngListStartRow+1).CellStyle then
blnShowHeader = true
exit for
end if
next i
end if
'Insert a helper column
oSheet.Columns.insertByIndex(intListEndColumn+1,1)
'number the elements in the helper column
for i=lngListStartRow to lngListEndRow
oSheet.getCellByPosition(intListEndColumn+1,i).value=i
next i
'at Andreas Saeger's (saegerei@onlinehome.de) suggestion at users@de.openoffice.org the number is faster this way
'but it is lost through the property "stable sort alogrythm"!
'dim dA(), rA()
'with oSheet.getCellRangeByPosition(intListEndColumn+1,lngListStartRow,intListEndColumn+1,lngListEndRow)
' dA() = .getDataArray()
' for i = lBound(dA()) to uBound(dA())
' rA() = dA(i)
' rA(0) = i
' next
' .setDataArray(dA())
'End With
oList =oSheet.getCellRangeByPosition(intListStartColumn,lngListStartRow,intListEndColumn+1,lngListEndRow)
'Sort
aSortFields(0).Field = intCriteriaColumn 'Column in which the user has marked the selected cell
aSortFields(0).IsAscending = blnUpDown
aSortFields(0).IsCaseSensitive = false
aSortFields(1).Field = intListEndColumn+1 'Helper column if the current order
aSortFields(1).IsAscending = true
aSortFields(1).IsCaseSensitive = false
aSortDesc(0).Name = "SortFields"
aSortDesc(0).Value = aSortFields()
aSortDesc(1).Name = "ContainsHeader"
aSortDesc(1).Value = blnShowHeader
oList.sort(aSortDesc())
'Remove helper column
oSheet.Columns.removeByIndex(intListEndColumn+1,1)
oList =oSheet.getCellRangeByPosition(intListStartColumn,lngListStartRow,intListEndColumn,lngListEndRow)
ThisComponent.CurrentController.Select(oList)
end sub
sub SelectCurrentRange
dim oDisp as object
dim oDoc as object
dim Array()
oDoc = ThisComponent.CurrentController.Frame
oDisp = createUnoService("{@see com.sun.star.frame.DispatchHelper}")
oDisp.executeDispatch(oDoc, ".uno:SortAscending", "", 0, Array())
oDisp.executeDispatch(ThisComponent.CurrentController.Frame,".uno:Undo", "",0, Array())
End Sub