Macro Writer-Table sorting

From The Document Foundation Wiki
< Macros‎ | Writer
Jump to: navigation, search

Description

This macro sorts a table in Writer pending on a column which contains the cursor.

There are 4 possibilities to sort a column:

  • ascending without a header row
  • descending without a header row
  • ascending with a header row
  • descending with a header row

This macro is additional available in a prepared extension. Link to the extension at LibreOffice's extension page: Writer Tabellen sortieren

This extension adds a new menu bar with 4 buttons in Writer, which are linked to the four macros.

Code

REM  *****  BASIC  *****

'Copyright (c) 2011 Frieder Delor, Mailto: delorfr@googlemail.com

'    This program is free software: you can redistribute it and/or modify
'    it under the terms of the GNU General Public License as published by
'    the Free Software Foundation, either version 3 of the License, or
'    (at your option) any later version.

'    This program is distributed in the hope that it will be useful,
'    but WITHOUT ANY WARRANTY; without even the implied warranty of
'    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'    GNU General Public License for more details.

'    You should have received a copy of the GNU General Public License
'    along with this program.  If not, see <http://www.gnu.org/licenses/>.
Option Explicit
'------------------------------------------
Sub sortWriterTableDescendingHeader
dim sAktivCell$
Dim sTableName As String  
Dim bAscending As boolean
Dim bHeader As boolean
Dim nSortColl As Long

  On Error GoTo ErrorHandler
  sTableName = ThisComponent.CurrentController.Selection.getByIndex(0).TextTable.Name
  sAktivCell = ThisComponent.CurrentController.Selection.getByIndex(0).Cell.CellName

 
  bAscending = False 'ASC sorting
  bHeader = True 'Table contains a header row
  nSortColl = getColumn(sAktivCell) 'the column which is the sorting key (first column=1)
   
  sort_Text_Table(sTableName,bAscending,bHeader,nSortColl)
ErrorHandler:
End Sub
'----------------------------
Sub sortWriterTableAscendingHeader
dim sAktivCell$
Dim sTableName As String
Dim bAscending As boolean
Dim bHeader As boolean
Dim nSortColl As Long

  On Error GoTo ErrorHandler
  sTableName = ThisComponent.CurrentController.Selection.getByIndex(0).TextTable.Name
  sAktivCell = ThisComponent.CurrentController.Selection.getByIndex(0).Cell.CellName

 
  bAscending = True 'ASC sorting
  bHeader = True 'Table contains a header row
  nSortColl = getColumn(sAktivCell) 'the column which is the sorting key (first column=1)
   
  sort_Text_Table(sTableName,bAscending,bHeader,nSortColl)
ErrorHandler:
End Sub
'----------------------------------
Sub sortWriterTableAscending
dim sAktivCell$
Dim sTableName As String
Dim bAscending As boolean
Dim bHeader As boolean
Dim nSortColl As Long

  On Error GoTo ErrorHandler
  sTableName = ThisComponent.CurrentController.Selection.getByIndex(0).TextTable.Name
  sAktivCell = ThisComponent.CurrentController.Selection.getByIndex(0).Cell.CellName

 
  bAscending = True 'ASC sorting
  bHeader = False 'Table contains a header row
  nSortColl = getColumn(sAktivCell) 'the column which is the sorting key (first column=1)
   
  sort_Text_Table(sTableName,bAscending,bHeader,nSortColl)
ErrorHandler:
End Sub
'-------------------------------------------
Sub sortWriterTableDescending
dim sAktivCell$
Dim sTableName As String
Dim bAscending As boolean
Dim bHeader As boolean
Dim nSortColl As Long

  On Error GoTo ErrorHandler
  sTableName = ThisComponent.CurrentController.Selection.getByIndex(0).TextTable.Name
  sAktivCell = ThisComponent.CurrentController.Selection.getByIndex(0).Cell.CellName

 
  bAscending = False 'ASC sorting
  bHeader = False 'Table contains a header row
  nSortColl = getColumn(sAktivCell) 'the column which is the sorting key (first column=1)
   
  sort_Text_Table(sTableName,bAscending,bHeader,nSortColl)
ErrorHandler:
End Sub

'------------------------------------------------------------------
sub sort_Text_Table (sTableName As String,bAscending As boolean,bHeader As boolean, nSortColl As Long)
Dim oTable as Object
dim oRange as Object
Dim nStartRow As Long
Dim sRange As String
Dim oSortFields(0) as New com.sun.star.table.TableSortField 
Dim oDescriptor As Variant

  oTable = ThisComponent.TextTables.getByName(sTableName)
    If bHeader Then
      nStartRow =1
    Else
      nStartRow =0
    End if

  sRange = GetTablerange(oTable,nStartRow)
  oRange = oTable.getCellRangeByName (sRange)
  
  oSortFields(0).Field = nSortColl
  oSortFields(0).IsAscending = bAscending  
  oSortFields(0).FieldType = com.sun.star.util.SortFieldType.ALPHANUMERIC
  
  oDescriptor = oTable.createSortDescriptor() 
  ' set descriptor's properties 
  oDescriptor(0).Name = "IsSortInTable" 
  oDescriptor(0).Value = True 
  'oDescriptor(1).Name = "Delimiter" 
  'oDescriptor(1).Value = True
  oDescriptor(2).Name = "IsSortColumns" 
  oDescriptor(2).Value = False 'True 
  'oDescriptor(3).Name = "MaxSortFieldsCount" 
  'oDescriptor(3).Value = 2 
  oDescriptor(4).Name = "SortFields" 
  oDescriptor(4).Value = oSortFields() 
  oRange.Sort(oDescriptor())

End sub

REM Returns the name of the sortrange
Function GetTablerange (oTable As Object, nStartRow As Long) As String 

  Dim sCell As string
  Dim oCursor As Object

  sCell = oTable.getCellByPosition(0, nStartRow).CellName 
  oCursor = oTable.createCursorByCellName (sCell)
 
  oCursor.gotoEnd (True)
  GetTablerange = oCursor.getRangeName

End Function
'------------------------------------------------------------------
'  Returns the index of the sortcolumn
Function getColumn (sAktivCell As String) As Long

Dim sTableName$
Dim i% ,n%
dim sChar$
Dim nCol as Long
n=0
nCol=0
For i=Len(sAktivCell) to 1 Step -1 
 sChar = UCase ( Mid(sAktivCell,i,1))
 If Not IsNumeric(sChar) Then
   nCol = (Asc(sChar)-64)*(26^n) + nCol
   n=n+1
 end if 
Next
getColumn = nCol
End Function