Macros/Writer/004/es
Appearance
TDF LibreOffice Document Liberation Project Blogs comunitarios Weblate Nextcloud Redmine Ask LibreOffice Donar
Descripción
Esta macro ordena una tabla de Writer alfabéticamente por la columna en que está el cursor.
El programa contiene cuatro subrutinas para:
- Ordenar por una columna alfabéticamente ascendente
- Ordenar por una columna alfabéticamente ascendente, excluyendo la fila del encabezado
- Ordenar por una columna alfabéticamente descendente
- Ordene por una columna alfabéticamente descendente, excluyendo la fila del encabezado
Esta macro también existe como extensión instalable descargándola del Centro de extenxiones de LibreOfficesortwriterTable-1.0.0.oxt. Al instalar la extensión se agrega una nueva barra de herramientas con 4 botones, que están vinculados a las cuatro macros.
Código
en 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
' Esquema de las subrutinas y funciones:
'
' ---> 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
'''Haga una llamada a cualquiera de las 4 subrrutinas en función de sus necesidades'''
sortWriterTableAscending
'sortWriterTableAscendingExclHeader
'sortWriterTableDescending
'sortWriterTableDescendingExclHeader
End Sub ' Main
Sub sortWriterTableAscending
'''Clasificar alfabeticamente ascendente por la columna en la que está el cursor'''
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 ' Ordenación ascendente
bHeader = False ' La tabla contiene una fila de encabezados
nSortColl = getColumn(sAktivCell) ' Columna que es la clave de clasificación (primera columna=1)
sortTextTable(sTableName, bAscending, bHeader, nSortColl)
ErrorHandler:
End Sub ' sortWriterTableAscending
Sub sortWriterTableAscendingExclHeader
'''Clasifica la la tabla por la columna en que está el cursor alfabéticamente ascendente, EXCLUYENDO el encabezado'''
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
'''Clasifica la la tabla por la columna en que está el cursor alfabéticamente ascendente'''
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 ' ordenación ascendente
bHeader = False ' La tabla contiene una fila de encabezados
nSortColl = getColumn(sAktivCell) ' Columna que es la clave de clasificación (primera columna=1)
sortTextTable(sTableName,bAscending,bHeader,nSortColl)
ErrorHandler:
End Sub ' sortWriterTableDescending
Sub sortWriterTableDescendingExclHeader
'''Clasifica la la tabla por la columna en que está el cursor alfabéticamente descendente, EXCLUYENDO el encabezado'''
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 ' ordenación ascendente
bHeader = True ' La tabla contiene una fila de encabezados
nSortColl = getColumn(sAktivCell) ' Columna que es la clave de clasificación (primera columna=1)
sortTextTable(sTableName,bAscending,bHeader,nSortColl)
ErrorHandler:
End Sub ' sortWriterTableDescendingExclHeader
Sub sortTextTable (sTableName As String, bAscending As Boolean, bHeader As Boolean, nSortColl As Long)
'''Rutina principal de clasificación'''
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
'''Devuelve el nombre del intervalo de clasificación'''
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
'''Devuelve el índice de la columna de clasificación'''
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