Macros

From The Document Foundation Wiki
< Macros‎ | Writer‎ | 004
Jump to: navigation, search

Comment trier un tableau ?

Les procédures présentées ici trient un tableau sur la colonne courante (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 sont aussi disponibles dans une extension cf. : Writer Tabellen sortieren

Cette extension ajoute un menu avec 4 boutons dans Writer, associés aux 4 macros.

Code

REM  *****  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
'------------------------------------------
Sub sortWriterTableDescendingHeader
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 'Tri ASC
  bHeader = True 'La Table contient une ligne de titre
  nSortColl = getColumn(sAktivCell) 'la colonne clé de tri (premiere colonne=1)
 
  sort_Text_Table(sTableName,bAscending,bHeader,nSortColl)
ErrorHandler:
End Sub
'----------------------------
Sub sortWriterTableAscendingHeader
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 'Tri ASC 
  bHeader = True 'La Table contient une ligne de titre
  nSortColl = getColumn(sAktivCell) 'la colonne clé de tri (premiere colonne=1)
 
  sort_Text_Table(sTableName,bAscending,bHeader,nSortColl)
ErrorHandler:
End Sub
'----------------------------------
Sub sortWriterTableAscending
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 'Tri ASC 
  bHeader = False 'La Table contient une ligne de titre
  nSortColl = getColumn(sAktivCell) 'la colonne clé de tri (premiere colonne=1)
 
  sort_Text_Table(sTableName,bAscending,bHeader,nSortColl)
ErrorHandler:
End Sub
'-------------------------------------------
Sub sortWriterTableDescending
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 'Tri ASC 
  bHeader = False 'La Table contient une ligne de titre
  nSortColl = getColumn(sAktivCell) 'la colonne clé de tri (premiere colonne=1)
 
  sort_Text_Table(sTableName,bAscending,bHeader,nSortColl)
ErrorHandler:
End Sub
  
'------------------------------------------------------------------
sub sort_Text_Table (sTableName As String,bAscending As boolean,bHeader As boolean, nSortColl As Long)
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() 
  ' set descriptor's properties 
  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
 
REM Returns the name of the sortrange
Function GetTablerange (oTable As Object, nStartRow As Long) As String 
 
  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
'------------------------------------------------------------------
'  Returns the index of the sortcolumn
Function getColumn (sAktivCell As String) As Long
 
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