Macros/Writer/004/es

    From The Document Foundation Wiki
    < Macros‎ | Writer
    This page is a translated version of the page Macros/Writer/004 and the translation is 4% complete.


    Other languages:

    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 ' getColumn