Macros pour trier un tableau

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


    Other languages:

    Description

    Les procédures présentées ici trient un tableau sur la colonne courante (selon la position où se trouve le curseur).

    Il y a 4 possibilités pour trier une colonne :

    • par ordre croissant sans ligne de titre
    • par ordre décroissant sans ligne de titre
    • par ordre croissant avec ligne de titre
    • par ordre décroissant avec ligne de titre

    Ces macros existent aussi sous la forme d'une extension téléchargeable sortwritertable-1.0.0.oxt qui installe 4 boutons associés aux quatre possibilités.

    Code

    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
    
    ' Schéma des Sub et Fonctions:
    '
    '     ---> 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
        '''Appelez l'un des quatre Subs, en fonction de vos besoins'''
    
        sortWriterTableAscending
        'sortWriterTableAscendingExclHeader
        'sortWriterTableDescending
        'sortWriterTableDescendingExclHeader
    
    End Sub ' Main
    
    
    Sub sortWriterTableAscending
        '''Trie la colonne sélectionnée par le curseur par ordre alphabétique ascendant'''
    
        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 ' trie ascendant
        bHeader = False ' La Table contient une ligne de titre
        nSortColl = getColumn(sAktivCell) ' la colonne clé de tri (premiere colonne=1)
       
        sortTextTable(sTableName, bAscending, bHeader, nSortColl)
        ErrorHandler:
    
    End Sub ' sortWriterTableAscending
    
    
    Sub sortWriterTableAscendingExclHeader
        '''Trie la colonne sélectionnée par le curseur par ordre alphabétique ascendant, EXCLUANT la ligne de titre'''
    
        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
        '''Trie la colonne sélectionnée par le curseur par ordre alphabétique ascendant'''
    
        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 ' trie ascendant
        bHeader = False ' La Table contient une ligne de titre
        nSortColl = getColumn(sAktivCell) ' la colonne clé de tri (premiere colonne=1)
       
        sortTextTable(sTableName,bAscending,bHeader,nSortColl)
        ErrorHandler:
    
    End Sub ' sortWriterTableDescending
    
    
    Sub sortWriterTableDescendingExclHeader
        '''Trie la colonne sélectionnée par le curseur par ordre alphabétique descendant, EXCLUANT la ligne de titre'''
    
        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 ' trie ascendant
        bHeader = True ' La Table contient une ligne de titre
        nSortColl = getColumn(sAktivCell) ' la colonne clé de tri (premiere colonne=1)
       
        sortTextTable(sTableName,bAscending,bHeader,nSortColl)
        ErrorHandler:
    
    End Sub ' sortWriterTableDescendingExclHeader
    
    
    Sub sortTextTable (sTableName As String, bAscending As Boolean, bHeader As Boolean, nSortColl As Long)
        '''Principale sub pour le triage'''
    
        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 
        '''Retourne le nom du sort de triage'''
    
        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
        '''Retourne l'index du colonne de triage'''
    
        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

    Fichier ODT pour tester la macro