現金出納帳を LibreOffice Calc で作ろうかと思ったんだが、
そういえば ゲーム用のスプレッドシートを作っていたときに
いくつか マクロを組んだんだった。
ちなみに そっちのゲームの方は 高校簿記のバランスシートの借方、貸方をヒントに
ベテランがぶち切れそうな インデント・スタイルのマクロにしたのだった。
Code モジュール
REM ***** BASIC *****
' Copyright (c) 2017 TAKAHASHI Satoshi (Handle: Muzudho)(Dojin circle: "Grayscale")
' Released under the MIT license
' http://opensource.org/licenses/mit-license.php
Option Explicit
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' コーディングの列幅を短くするためのライブラリです。
' このコードで使われている命名の略称表記
' dc ... document
' sh ... sheet
' cm ... column
' rw ... row
' ce ... cell
' vl ... value
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' 文書を新規作成 CreateDocument
Sub CreateDc ( ) As Object
CreateDc = StarDesktop.loadComponentFromURL( _
"private:factory/scalc" ,"_blank" ,0 ,Array() )
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' 文書を読込 GetDocument
' dcFile .odsファイルへのパス
Sub GetDc ( dcFile As String ) As Object
GetDc = StarDesktop.loadComponentFromURL( _
ConvertToUrl(dcFile) ,"_blank" ,0 ,Array() )
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' 文書を保存して閉じる SaveAndCloseDocument
' dc 文書
' dcFile .odsファイルへのパス
Sub SaveAndCloseDc ( dc As Object ,dcFile As String )
' .odsとして保存
dc.storeAsURL( ConvertToUrl( dcFile ) ,Array() )
' ファイルを閉じる
dc.dispose
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' シート挿入 InsertSheet
' dc 文書
' shName シート名
' position シートを差し込む位置。左端が0
Sub InsertSh ( dc As Object ,shName As String _
,position As Integer )
dc.getSheets().insertNewByName( shName ,position )
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' シートをアクティブにします SetActiveSheet
' dc 文書
' sh シート
Sub SetActiveSh ( dc As Object ,sh As Object )
dc.getCurrentController().setActiveSheet( sh )
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' シート取得 GetSheet
' dc 文書
' shName シート名
Sub GetSh ( dc As Object ,shName As String ) As Object
GetSh = dc.getSheets().getByName( shName )
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' シート存在判定 HasSheet
' dc 文書
' shName シート名
Sub HasSh ( dc As Object ,shName As String ) As Boolean
HasSh = dc.getSheets().hasByName( shName )
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' セル取得 GetCellObject
' sh シート
' cm 列番号(0スタート)
' rw 行番号(0スタート)
Sub GetCeOb ( sh As Object ,cm As Integer ,rw As Integer ) As Object
GetCeOb = sh.getCellByPosition( cm ,rw )
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' セルの値を取得 GetCell
' sh シート
' cm 列番号(0スタート)
' rw 行番号(0スタート)
Sub GetCe ( sh As Object ,cm As Integer ,rw As Integer ) As String
GetCe = sh.getCellByPosition( cm ,rw ).String
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' セルに値を設定 SetCell
' sh シート
' cm 列番号(0スタート)
' rw 行番号(0スタート)
' vl 設定したい値
Sub SetCe ( sh As Object ,cm As Integer ,rw As Integer , vl As String )
sh.getCellByPosition( cm ,rw ).String = vl
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' セルからセルへ値を複写 CopyCell
' sh0 シート
' cm0 列番号(0スタート)
' rw0 行番号(0スタート)
' sh1 シート
' cm1 列番号(0スタート)
' rw1 行番号(0スタート)
Sub CopCe ( sh0 As Object ,cm0 As Integer ,rw0 As Integer _
,sh1 As Object ,cm1 As Integer ,rw1 As Integer )
sh0.getCellByPosition( cm0 ,rw0 ).String = sh1.getCellByPosition( cm1 ,rw1 ).String
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' カウントアップ（カウントダウン）
' vl 更新したい変数
' offset 増減する量
Sub CountUp ( vl As Integer , offset As Integer )
vl = vl + offset
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' 文字列を末尾に追加
' vl 更新したい変数
' tail 追加したい文字列
Sub AppendTail ( vl As String ,tail As String )
vl = vl & tail
End Sub
Utility モジュール
REM ***** BASIC *****
' Copyright (c) 2017 TAKAHASHI Satoshi (Handle: Muzudho)(Dojin circle: "Grayscale")
' Released under the MIT license
' http://opensource.org/licenses/mit-license.php
Option Explicit
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' CSV読込、シート検索ライブラリ
' このコードで使われている命名の略称表記
' dc ... document
' sh ... sheet
' cm ... column
' rw ... row
' ce ... cell
' vl ... value
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' CSVファイルを読込んでシートに書き写します
Sub ReadCsv( dc As Object, filename As String, sh as Object)
' シートをアクティブにします
Code.SetActiveSh( dc ,sh )
If Not FileExists( filename ) Then
Msgbox( filename & _
" ファイルがありません。エクスポートしましたか？")
End If
' 外部ファイルの内容をシートに読込みます
Dim fileHandle As Integer
fileHandle = Freefile
Open filename For Input As fileHandle
Dim rw As Integer
Dim source As String
rw = 0
Do While not eof(fileHandle)
Line Input #fileHandle, source
Utility.CsvLineParser( sh ,rw , source )
Code.CountUp( rw, 1 )
Loop
Close #fileHandle
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' CSV文字列を読込み、シートに入れます
' sh 設定先シート
' rw 設定先行番号(0スタート)
' source 読込む１行分のCSV文字列
Sub CsvLineParser( _
sh As Object _
,rw As Integer _
,source As String _
)
' 空文字列なら何もしません
If Len(source) < 1 Then
Exit Sub
End If
' caret 何文字目か。(1スタート)
' cm 列番号 (0スタート)
' vl_ce １セル分の文字列
Dim caret As Integer
Dim cm As Integer
Dim vl_ce As String
caret = 1
cm = 0
vl_ce = ""
' このループで１行分に対応
' 最後の文字でなければ（caret-1）実行
Do While caret-1 < Len(source)
Select Case Mid(source,caret,1)
' カンマを読込んだら、溜めているセル値を出力して次へ
Case ",":
Code.CountUp( caret ,1 )
Code.SetCe ( sh ,cm ,rw , vl_ce )
Code.CountUp( cm ,1 )
vl_ce = ""
' ダブルクォーテーションを読込んだら、リテラル文字列処理へ
Case """":
Code.CountUp( caret ,1 )
' エスケープしながら、単独「"」が出てくるまでそのまま出力
Do While caret-1 < Len(source)
If """"=Mid(source,caret,1) Then
' 「"」が最後の文字だったのなら、無視してループ抜け
If caret + 1 - 1 = Len(source) Then
Code.CountUp( caret ,1 )
Exit Do
' ２連続の「"」なら１つの「"」に変換してループ続行
ElseIf _
"""" = Mid(source,caret+1,1) _
Then
Code.CountUp( caret ,2 )
Code.AppendTail( vl_ce , """" )
Else
' 2連続でない「"」なら、次の「,」の次までの空白等をスキップしてループ抜け。(2012-10-30 変更 旧:index++;)(2017-02-01 変更 旧:index+=2;)
caret = InStr( caret, source, "," )
Code.CountUp( caret ,1 )
Exit Do
End If
Else
' 通常文字なので読み取ってループ続行
Code.AppendTail( vl_ce , Mid(source,caret,1) )
Code.CountUp( caret ,1 )
End If
Loop
' 前後の空白はカット
Code.SetCe( sh ,cm ,rw , Trim(vl_ce) )
Code.CountUp( cm ,1 )
vl_ce = ""
' ダブルクォートされていない文字列か、ダブルクォートの前のスペースはそのまま読取
Case Else:
Code.AppendTail( vl_ce , Mid(source,caret,1) )
Code.CountUp( caret ,1 )
End Select
Loop
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' カンマや、ダブルクオーテーションを含む文字列を、
' ダブルクォーテーションで挟みます。
' この際、ダブルクォーテーション１つは ２つ に変換します。
' source セル１つ分のCSV文字列
Sub EscapeCsv(source As String) As String
' エスケープが必要なら真
Dim isEscape As Boolean
isEscape = false
Dim str As String
str = ""
' caret 何文字目か。(1スタート)
Dim caret As Integer
For caret = 1 To Len(source)
' カンマが含まれていれば、エスケープを必要扱いにします。
' (2017-02-09 追加 LF改行コード10、CR復帰コード13 が含まれていれば、エスケープを必要扱いにします)
If _
","= Mid( source, caret, 1 ) Or _
Chr$(10) = Mid( source, caret, 1 ) Or _
Chr$(13) = Mid( source, caret, 1 ) _
Then
isEscape = true
Code.AppendTail( str , Mid( source, caret, 1 ) )
ElseIf """" = Mid( source, caret, 1 ) Then ' ダブルクォーテーションが含まれていたので、エスケープが必要になりました
isEscape = true
Code.AppendTail( str , """""" ) ' ダブルクォーテーションを、１つの代わりに２つ追加
Else
Code.AppendTail( str , Mid( source, caret, 1 ) )
End If
Next
' 必要なら、ダブルクォーテーションで挟みます
If isEscape Then
str = """" & str & """"
End If
EscapeCsv = str
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' 行番号をシート検索
' vl_expected 探して一致したい行値
' sh_target 探すシート
' cm_target 探す列
' rw_first 探し始める行
' rw_lastOver 最終行の次
Sub RowOf( _
vl_expected As String _
,sh_target As Object _
,cm_target As Integer _
,rw_first As Integer _
,rw_lastOver As Integer _
) As Integer
Dim rw As Integer
For rw = rw_first To rw_lastOver - 1
If _
vl_expected = Code.GetCe( sh_target _
,cm_target ,rw ) _
Then
RowOf = rw
Exit Sub
End If
Next
RowOf = -1
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' 列番号をシート検索
' vl_expected 探して一致したい列値
' sh_target 探すシート
' rw_target 探す行
' cm_first 探し始める列
' cm_lastOver 最終列の次
Sub ColumnOf( _
vl_expected As String _
,sh_target As Object _
,rw_target As Integer _
,cm_first As Integer _
,cm_lastOver As Integer _
) As Integer
Dim cm As Integer
For cm = cm_first To cm_lastOver - 1
If _
vl_expected = Code.GetCe( sh_target ,cm _
,rw_target ) Then
ColumnOf = cm
Exit Sub
End If
Next
ColumnOf = -1
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' セル値をシート検索
' vl_foreignKey 探して一致したい値
' sh_target 探すシート
' cm_key 探す列
' cm_value 取得したい値が入っている列
Sub VLookup( _
vl_foreignKey As String _
,sh_target As Object _
,cm_key As Integer _
,cm_value As Integer _
) As String
Dim rw_foreignSheet As Integer
rw_foreignSheet = 0
Do While "[EOF]" <> Code.GetCe( sh_target _
,0 ,rw_foreignSheet )
If _
vl_foreignKey = Code.GetCe( sh_target _
,cm_key ,rw_foreignSheet ) _
Then
VLookup = Code.GetCe( sh_target ,cm_value ,rw_foreignSheet )
Exit Sub
End If
Code.CountUp( rw_foreignSheet , 1 )
Loop
VLookup = "#NotFound#"
End Sub
'---------------------------------------------------------------=---------------------------------------------------------------'--------------------------------
' 2列を ドットでつないで １つのキーにします
Sub ConcatKey2( sh As Object _
,cm0 As Integer _
,cm1 As Integer _
,rw As Integer _
,joinDelimiter As String _
) As String
Dim key1 As String
Dim key2 As String
key1 = Code.GetCe( sh ,cm0 ,rw )
key2 = Code.GetCe( sh ,cm1 ,rw )
ConcatKey2 = key1 & joinDelimiter & key2
End Sub
' 3列を ドットでつないで １つのキーにします
Sub ConcatKey3( sh As Object _
,cm0 As Integer _
,cm1 As Integer _
,cm2 As Integer _
,rw As Integer _
,joinDelimiter As String _
) As String
Dim key1 As String
Dim key2 As String
Dim key3 As String
key1 = Code.GetCe( sh ,cm0 ,rw )
key2 = Code.GetCe( sh ,cm1 ,rw )
key3 = Code.GetCe( sh ,cm2 ,rw )
ConcatKey3 = key1 & joinDelimiter & key2 & joinDelimiter & key3
End Sub
よーし、ライブラリを再利用するぜ。
あっ、MITライセンスにしとこ……。