Macros/Writer/004/es
TDF LibreOffice en español Document Liberation Project Blogs comunitarios Weblate Nextcloud Redmine Preguntas y respuestas Donar
Description
This macro sorts a table column in LibreOffice Writer alphabetically, for the column which contains the cursor.
The program contains four subroutines which:
- Sort a column alphabetically ascending
- Sort a column alphabetically ascending, excluding the header row
- Sort a column alphabetically descending
- Sort a column alphabetically descending, excluding the header row
This macro also exists in an equivalent form as an extension, by clicking this link for download of sortwritertable-1.0.0.oxt. Upon download, the extension adds a new toolbar with 4 buttons, which are linked to the four macros.
Code
In LibreOffice 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
' <span lang="en" dir="ltr" class="mw-content-ltr">Outline of Subs & Functions:</span>
'
' ---> Sub sortWriterTableAscending
' ---> Sub sortWriterTableAscendingExclHeader
' ---> Sub sortWriterTableDescending
' ---> Sub sortWriterTableDescendingExclHeader
'
' ---> Sub sortTextTable (sTableName As String, bAscending As Boolean, bHeader As Boolean, nSortColl As Long)
' ---> Function getTableRange (oTable As Object, nStartRow As Long) As String
' ---> Function getColumn (sAktivCell As String) As Long
Sub Main
'''<span lang="en" dir="ltr" class="mw-content-ltr">Call one of the four subroutines, based on your needs</span>'''
sortWriterTableAscending
'sortWriterTableAscendingExclHeader
'sortWriterTableDescending
'sortWriterTableDescendingExclHeader
End Sub ' Main
Sub sortWriterTableAscending
'''<span lang="en" dir="ltr" class="mw-content-ltr">Sorts cursor-selected column alphabetically ascending</span>'''
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 ' <span lang="en" dir="ltr" class="mw-content-ltr">asc sorting</span>
bHeader = False ' <span lang="en" dir="ltr" class="mw-content-ltr">table contains a header row</span>
nSortColl = getColumn(sAktivCell) ' <span lang="en" dir="ltr" class="mw-content-ltr">the column which is the sorting key (first column=1)</span>
sortTextTable(sTableName, bAscending, bHeader, nSortColl)
ErrorHandler:
End Sub ' sortWriterTableAscending
Sub sortWriterTableAscendingExclHeader
'''<span lang="en" dir="ltr" class="mw-content-ltr">Sorts cursor-selected column alphabetically ascending, EXCLUDING the header</span>'''
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)
sortTextTable(sTableName,bAscending,bHeader,nSortColl)
ErrorHandler:
End Sub ' sortWriterTableAscendingExclHeader
Sub sortWriterTableDescending
'''<span lang="en" dir="ltr" class="mw-content-ltr">Sorts cursor-selected column alphabetically ascending</span>'''
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 ' <span lang="en" dir="ltr" class="mw-content-ltr">asc sorting</span>
bHeader = False ' <span lang="en" dir="ltr" class="mw-content-ltr">table contains a header row</span>
nSortColl = getColumn(sAktivCell) ' <span lang="en" dir="ltr" class="mw-content-ltr">the column which is the sorting key (first column=1)</span>
sortTextTable(sTableName,bAscending,bHeader,nSortColl)
ErrorHandler:
End Sub ' sortWriterTableDescending
Sub sortWriterTableDescendingExclHeader
'''<span lang="en" dir="ltr" class="mw-content-ltr">Sorts cursor-selected column alphabetically descending, EXCLUDING the header</span>'''
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 ' <span lang="en" dir="ltr" class="mw-content-ltr">asc sorting</span>
bHeader = True ' <span lang="en" dir="ltr" class="mw-content-ltr">table contains a header row</span>
nSortColl = getColumn(sAktivCell) ' <span lang="en" dir="ltr" class="mw-content-ltr">the column which is the sorting key (first column=1)</span>
sortTextTable(sTableName,bAscending,bHeader,nSortColl)
ErrorHandler:
End Sub ' sortWriterTableDescendingExclHeader
Sub sortTextTable (sTableName As String, bAscending As Boolean, bHeader As Boolean, nSortColl As Long)
'''<span lang="en" dir="ltr" class="mw-content-ltr">Sorting master subroutine</span>'''
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()
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 ' sortTextTable
Function getTableRange (oTable As Object, nStartRow As Long) As String
'''<span lang="en" dir="ltr" class="mw-content-ltr">Returns the name of the sort-range</span>'''
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 ' getTableRange
Function getColumn (sAktivCell As String) As Long
'''<span lang="en" dir="ltr" class="mw-content-ltr">Returns the index of the sort-column</span>'''
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 ' getColumnODT file to test macro