LibreOffice Calc で組んだマクロ

現金出納帳を LibreOffice Calc で作ろうかと思ったんだが、
そういえば　ゲーム用のスプレッドシートを作っていたときに
いくつか　マクロを組んだんだった。

ちなみに　そっちのゲームの方は　高校簿記のバランスシートの借方、貸方をヒントに
ベテランがぶち切れそうな　インデント・スタイルのマクロにしたのだった。

#Code モジュール

```LibreOfficeBasic
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 モジュール

```LibreOfficeCalc
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ライセンスにしとこ……。