マクロ/Writer/004
Appearance
TDF LibreOffice Document Liberation Project Community Blogs Weblate Nextcloud Redmine Ask LibreOffice Donate
説明
このマクロは、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