Macros/Writer/004/nl
Appearance
TDF LibreOffice Document Liberation Project Blogs gemeenschap Weblate Nextcloud Redmine Ask LibreOffice Doneren
Beschrijving
Deze macro sorteert een tabelkolom in LibreOffice Writer alfabetisch, het is de kolom waar de cursor in staat.
Het programma bevat vier subroutines voor het:
- Een kolom alfabetisch oplopend sorteren
- Een kolom alfabetisch oplopend sorteren, uitgezonderd de kopregel
- Een kolom alfabetisch aflopend sorteren
- Een kolom alfabetisch aflopend sorteren, uitgezonderd de kopregel
Deze macro bestaat ook in een equivalente vorm als een extensie, u kunt deze in het bestand sortwritertable-1.0.0.oxt downloaden. Bij het downloaden voegt de extensie een nieuwe werkbalk toe met 4 knoppen, die gekoppeld zijn aan de vier macro's.
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
' Overzicht van subroutines en functies:
'
' ---> 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
'''Roep een van de vier subroutines aan, op basis van uw behoeften'''
sortWriterTableAscending
'sortWriterTableAscendingExclHeader
'sortWriterTableDescending
'sortWriterTableDescendingExclHeader
End Sub ' Main
Sub sortWriterTableAscending
'''Sorteert de door de cursor geselecteerde kolom alfabetisch oplopend'''
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 ' tabel bevat een veldnamenrij
nSortColl = getColumn(sAktivCell) ' de kolom die de sorteersleutel is (eerste kolom = 1)
sortTextTable(sTableName, bAscending, bHeader, nSortColl)
ErrorHandler:
End Sub ' sortWriterTableAscending
Sub sortWriterTableAscendingExclHeader
'''Sorteert de door de cursor geselecteerde kolom alfabetisch oplopend, EXCLUSIEF de koptekst'''
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
'''Sorteert de door de cursor geselecteerde kolom alfabetisch oplopend'''
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 ' tabel bevat een veldnamenrij
nSortColl = getColumn(sAktivCell) ' de kolom die de sorteersleutel is (eerste kolom = 1)
sortTextTable(sTableName,bAscending,bHeader,nSortColl)
ErrorHandler:
End Sub ' sortWriterTableDescending
Sub sortWriterTableDescendingExclHeader
'''Sorteert de door de cursor geselecteerde kolom alfabetisch aflopend, EXCLUSIEF de koptekst'''
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 ' tabel bevat een veldnamenrij
nSortColl = getColumn(sAktivCell) ' de kolom die de sorteersleutel is (eerste kolom = 1)
sortTextTable(sTableName,bAscending,bHeader,nSortColl)
ErrorHandler:
End Sub ' sortWriterTableDescendingExclHeader
Sub sortTextTable (sTableName As String, bAscending As Boolean, bHeader As Boolean, nSortColl As Long)
'''Sorting master subroutine'''
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
'''Geeft de naam van het sorteerbereik'''
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
'''Geeft de index van de sorteerkolom'''
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 ' getColumn