System-9

LibreOffice Basicによる西暦和暦変換プログラム

LibreOffice Basicによる和暦と西暦の変換プログラムのサンプルです。
明治から平成までのプログラムはよくあるのですが、紀元前660年の神武天皇以降をすべて西暦に変換でき、さらに西暦から和暦への変換もできるようにしてみました。さらに、南朝と北朝についても、シートを替えて計算できるようにしています。シート内の数字は、その元号の元年における西暦年です。マイナスはもちろん紀元前を表します。

ダイアログ内のリストボックスのマクロによる利用方法のサンプルとして作成していますので、元号と西暦の正確性などは全く責任を持ちませんのであしからず。

fig

西暦和暦換算プログラムシート

[西暦和暦変換]ボタンをクリックすると、以下のダイアログが表示されます。

fig

西暦和暦換算処理ダイアログ

ダイアログは、LibreOffice Basic編集ダイアログ内の、メニューの「ツール」→「マクロ」→「ダイアログの管理」で作成しておきます。 Dialog1という名前であったとします。その中に作成したリストボックス名がListBox1であったとします。
まずオブジェクト変数 oListBox1とDlgにダイアログとリストボックスを設定します。

DialogLibraries.LoadLibrary("Standard")
Dlg = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
oListBox1 = Dlg.getControl("ListBox1")

現在のシート内の元号の文字列をB列から読み取って、リストボックスにセットするとともに、
その元号元年の西暦年を配列変数iSeireki()に読み込むために、以下のように処理しています。
oDoc=ThisComponent
oSheet = oDoc.CurrentController.ActiveSheet
'B列の最終行を取得
endRow=CInt(GetEndRow(oDoc , oSheet , "B"))
startRow=1 '年号データブロック先頭行

'ListBoxに年号リストをセット
for n=startRow to endRow
v = oSheet.getCellByPosition(1, n).String
nCount = oListBox1.getItemCount()
sNengo(n-startRow)=v
iSeireki(n-startRow)=oSheet.getCellByPosition(2, n).Value
oListBox1.additem( v, nCount)
next n

この後、フォームを表示します。 Dlg.execute()
Dlg.Dispose()

ダイアログ表示後は、[西暦→和暦]ボタンか[和暦→西暦]ボタンを押すと変換処理を行います。この辺りは特に説明の必要はないでしょう。

マクロを含むCalcのファイルも掲載しておきます。
日本年号と西暦換算表のCalcファイル　「日本年号と西暦換算表.ods」

<< SDメモリUSBメモリ激安　上海問屋 >>

' by Kom. 2013
Dim oListBox1 as Object
Dim oSeireki as Object
Dim oNengoText as Object
Dim oNengoNum as Object
Dim Dlg as Object
Dim sNengo(280) as String
Dim iSeireki(280) as Integer
Dim startRow as Integer
Dim endRow as Integer
Dim oDoc As Object
Dim oSheet as Object 

Sub Main
	
	startRow=1 '年号データブロック先頭行
	'endRow '年号データブロック最終行


	DialogLibraries.LoadLibrary("Standard")
    Dlg = CreateUnoDialog(DialogLibraries.Standard.Dialog1)
	oListBox1 = Dlg.getControl("ListBox1")

    oSeireki = Dlg.getControl("TextField1")
	oNengoNum = Dlg.getControl("TextField2")
	oNengoText = Dlg.getControl("TextField3")
	
	oDoc=ThisComponent
	oSheet = oDoc.CurrentController.ActiveSheet

	'B列の最終行を取得
	endRow=CInt(GetEndRow(oDoc , oSheet , "B"))

    'ListBoxに年号リストをセット
 	for n=startRow to endRow
		v = oSheet.getCellByPosition(1, n).String
		nCount = oListBox1.getItemCount()
		sNengo(n-startRow)=v
		iSeireki(n-startRow)=oSheet.getCellByPosition(2, n).Value
		oListBox1.additem( v, nCount)			
	next n

	iSeireki(endRow-startRow+1)=9999
	oListBox1.selectItemPos(endRow-startRow, True)
 
   'フォームを表示する
    Dlg.execute()
    Dlg.Dispose()
 
End Sub

Sub WestToJpnBtn()
	'西暦→和暦
	nPos=0
	seireki=CInt(oSeireki.Text)
	retval=0

	if seireki < iSeireki(0)  or oSeireki.Text="" then
		MsgBox("西暦年の指定が範囲外です。")
		Exit Sub
	end if
	
	for i=0 to endRow - startRow
		if  iSeireki(i) <= seireki and iSeireki(i+1) > seireki then
			retval= 	seireki - iSeireki(i)+1 
			Exit For
		end if
	next i

	oNengoText.Text= sNengo(i)
	oNengoNum.Text=CStr(retval)
End Sub

Sub JpnToWestBtn()
	'和暦→西暦
	if  oNengoNum.Text="" then
		MsgBox("和暦年の欄が空白です。")
		Exit Sub
	end if

	nPos = oListBox1.getSelectedItemPos()
	yRange = iSeireki(nPos+1) - iSeireki(nPos)

	if CInt(oNengoNum.Text) > CInt(yRange) or CInt(oNengoNum.Text)<1 then
		MsgBox("和暦年の指定値が範囲外です。")
		Exit Sub
	end if

	seireki= iSeireki(nPos) + CInt(oNengoNum.Text) -1
	oSeireki.Text=CStr(seireki)
End Sub

Sub ListSelected()
	'リスト項目をクリックして選択時に、年号テキストボックスに反映。
	'プログラム上は年号テキストボックスに無関係に変換処理する。
	nPos = oListBox1.getSelectedItemPos()
	oNengoText.Text=oListBox1.getSelectedItem()
End Sub

Function GetEndRow(oDc as object, oSht as object, sCol as String) as Long 'sColは"D"のように列名で指定 
	'Get end row of specified Column
	'指定列のデータが入っている最終行を返す。
	Dim oCursor as Object 
	Dim oCntrl as Object 
	Dim oFrame as Object 
	Dim oDispatcher as Object 
	Dim oProp(2) as new com.sun.star.beans.PropertyValue 
	Dim nShtEndRow as Long 
	Dim nEndRow as Long 
	Dim oDisp as String 
	oCursor = oSht.createCursor() 
	nShtEndRow = oCursor.getRangeAddress().EndRow 
	' 
	oCntrl = oDc.getCurrentController() 
	oFrame = oCntrl.Frame 
	oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper") ' 
	oProp(0).Name = "ToPoint" 
	oProp(0).Value = "$" & sCol & "$" & nShtEndRow 
	oProp(1).Name = "Sel" 
	oProp(1).Value = false 
	oDispatcher.executeDispatch( oFrame, ".uno:GoToCell", "", 0, oProp()) ' 
	oProp(0).Name = "By" 
	oProp(0).Value = 1 
	oProp(1).Name = "Sel" 
	oProp(1).Value = false 
	oDispatcher.executeDispatch( oFrame, ".uno:GoUpToStartOfData", "", 0, oProp()) 
	nEndRow = oCntrl.getSelection().getRangeAddress().EndRow ' 
	'oDisp = "[ Address of End Row ]" & Chr$(10) & "End Row = " & nEndRow ' 
	'msgbox(oDisp,0,"最終行取得")
	GetEndRow=nEndRow 
End Function

OpenOfficeマクロプログラミング―「Writer」「Calc」「Base」…OOoをBasicで便利に! (I・O BOOKS)

Lenovo ノートPC ThinkPad

iLEDについて

Javaサンプル

Netbeans

Libre Office Basicマクロ

その他

LibreOffice Basicによる西暦和暦変換プログラム