Jump to content

マクロ/Writer/004

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


説明

このマクロは、LibreOffice Writer のテーブルカラムを、カーソルがあるカラムのアルファベット順にソートします。

このプログラムには、次の4つのサブルーチンが含まれています。

  • 列をアルファベット順に昇順でソート
  • 列をアルファベット順に昇順でソート (ヘッダー行を除く)
  • 列をアルファベット順に降順でソート
  • 列をアルファベット順に降順でソート (ヘッダー行を除く)

このマクロは、拡張機能として同等のものが提供されており、このリンクをクリックして sortwritertable-1.0.0.oxt をダウンロード することができます。ダウンロードしインストールすると、この拡張機能により 4つのボタンを持つ新しいツールバーを追加され、それらは 4つのマクロにリンクされています。

Code

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

' マクロ(Sub & Function)の概要:
'
'     ---> 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
    '''必要に応じて、4つのサブルーチンのいずれかを呼び出します。'''

    sortWriterTableAscending
    'sortWriterTableAscendingExclHeader
    'sortWriterTableDescending
    'sortWriterTableDescendingExclHeader

End Sub ' Main


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 ' 昇順ソート
    bHeader = False ' テーブルにはヘッダ行があります
    nSortColl = getColumn(sAktivCell) ' ソート・キーとなる列 (最初の列=1)
   
    sortTextTable(sTableName, bAscending, bHeader, nSortColl)
    ErrorHandler:

End Sub ' sortWriterTableAscending


Sub sortWriterTableAscendingExclHeader
    '''カーソルで選択した列を、ヘッダーを除いてアルファベット順に昇順でソート'''

    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
    '''カーソルで選択した列をアルファベット順に昇順でソート'''

    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 ' 昇順ソート
    bHeader = False ' テーブルにはヘッダ行があります
    nSortColl = getColumn(sAktivCell) ' ソート・キーとなる列 (最初の列=1)
   
    sortTextTable(sTableName,bAscending,bHeader,nSortColl)
    ErrorHandler:

End Sub ' sortWriterTableDescending


Sub sortWriterTableDescendingExclHeader
    '''カーソルで選択した列を、ヘッダーを除いてアルファベット順に降順でソート'''

    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 ' 昇順ソート
    bHeader = True ' テーブルにはヘッダ行があります
    nSortColl = getColumn(sAktivCell) ' ソート・キーとなる列 (最初の列=1)
   
    sortTextTable(sTableName,bAscending,bHeader,nSortColl)
    ErrorHandler:

End Sub ' sortWriterTableDescendingExclHeader


Sub sortTextTable (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() 

    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 
    '''ソート範囲の名前を返します'''

    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
    '''ソート列のインデックスを返します'''

    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

マクロのテスト用 ODT ファイル