LibreOffice(Calc)でのマクロ : 17. 見積書作成 (10) – 管理台帳への転記

ユーザー Mr. Union の写真
2014年8月21日 -- Mr. Union

見積書を作成したら、これを自動的に管理台帳に記録しておくと、あとで案件整理をするのにも便利です。ここでは、管理台帳を見積書作成用ファイルとは用意 してみます。下図のように、1行目の左から、「見積番号」、「日付」、「宛先」、「品名」、「金額」と入力し、これをシート名「見積書」として、「管理台 帳.ods」というファイル名で保存します。

クリックで拡大します

保存したファイルは、見積書作成ファイルと同じディレクトリーに置いておきます。

クリックで拡大します

次に、見積書作成ファイルを開き、上のように作った管理台帳に、自動転記されるマクロを作成します。そのマクロは以下の通りです。

 

Sub Daicho



 ' 管理台帳のファイルを操作するための変数定義 Dim dummy() Dim OFPath As String Dim OFSheet As String Dim oOFDoc As Object Dim oOFSheet As Object Dim oDoc As Object Dim oSheet As Object Dim oSheet2 As Object Dim oCel As Object Dim SData As String Dim strPath As String



' 各項目の内容を扱うための変数定義 Dim Word(1 to 5) As String Dim i as long Dim ii As Long Dim MaxRow As Long Dim Pos(1 to 5) As String Dim Position As String Dim PreWord (1 to 5) As String Dim AftWord (1 to 5) As String Dim WLen As Long Dim AWLen As Long Dim PWLen As Long

 ' 各項目名の設定 Word(1)="見積番号" Word(2)="日付" Word(3)="宛先" Word(4)="品名" Word(5)="合計"

 oDoc=StarDesktop.CurrentComponent oSheet=oDoc.getSheets.getByName("見積書定義") oSheet2=oDoc.getSheets.getByName("見積書フォーム")

 ' 「見積書定義」シート「A列」の最大行数の取得 oRange = oSheet.getCellRangeByName("A1") oCursor = oSheet.createCursorByRange(oRange) oCursor.gotoEndOfUsedArea(True) MaxRow=oCursor.Rows.Count

 ' 管理台帳に転記する内容の取得 For i=1 to 5 For ii=1 to MaxRow oCel=oSheet.getCellByPosition(0,ii) SData=oCel.String

 ' 管理台帳に転記する内容が存在するセル座標の取得 If Word(i)=SData Then oCel=oSheet.getCellByPosition(1,ii) PreWord(i)=oCel.String oCel=oSheet.getCellByPosition(2,ii) AftWord(i)=oCel.String oCel=oSheet.getCellByPosition(4,ii) Pos(i)=oCel.String Position=Pos(i)

 ' 管理台帳に転記する内容の前置語と後置語の除去処理 oCel=oSheet2.getCellRangeByName(Position) Word(i)=oCel.String If PreWord(i)<>"" Then WLen=Len(Word(i)) PWLen=Len(PreWord(i)) Word(i)=Right(Word(i),WLen-PWLen) End If

 If AftWord(i)<>"" Then WLen=Len(Word(i)) AWLen=Len(AftWord(i)) Word(i)=Left(Word(i),WLen-AWLen) End If

 Exit For End If Next ii Next i

 ' 管理台帳ファイルのパスを設定する OFSheet="見積書" aURL = CreateUnoStruct("com.sun.star.util.URL") aURL.Complete = ThisComponent.URL CreateUnoService("com.sun.star.util.URLTransformer").parseStrict(aURL) strPath = aURL.Path

 SData=ConvertToUrl("管理台帳.ods") SData=Right(SData,Len(SData)-8) OFPath="file://" & strPath & SData

 ' 管理台帳ファイルを開く oOFDoc = StarDesktop.loadComponentFromURL(ConvertToUrl(OFPath), "_blank", 0, dummy()) oOFSheet = oOFDoc.Sheets.getByName(OFSheet )

 ' 管理台帳の最終行数を取得する oRange = oOFSheet.getCellRangeByName("A1") oCursor = oOFSheet.createCursorByRange(oRange) oCursor.gotoEndOfUsedArea(True) MaxRow=oCursor.Rows.Count

 ' 管理台帳に転記する For i=1 to 5 oCel=oOFSheet.getCellByPosition(i-1,MaxRow) oCel.String=Word(i) Next i

 ' 管理台帳ファイルを保存して閉じる oOFDoc.Store() oOFDoc.Close(True)

 End Sub

これで、見積書作成ファイルと同じフォルダーに存在する「管理台帳.ods」というファイルに、見積書への入力内容を転記するマクロ「Daicho」がで きました。続いて、これを実行させるために、既に作成してあるマクロ「AddItem」に、「Daicho」を追記します。具体的には、以下の通りとなり ます。また、せっかくのなので、処理が完了した際に表示されるメッセージボックスには、管理台帳に転記がなされた旨を伝える文言に変更します。

Sub AddItem

 Dim Fld(1 to 41 ) As Object Dim ChBox As Object Dim oSheet1 As Object Dim oSheet2 As Object Dim oCel As Object Dim Str(1 to 41) As String Dim Val(1 to 41) As Long Dim i As Long Dim iMod As long Dim iWari As long Dim RowPos As Long Dim BCol(3) As Long Dim BRow(3) As Long Dim Position As String Dim ItemVol As Integer Dim Tax As Currency Dim TaxS As Long Dim Sum As Long

 oDoc=StarDesktop.CurrentComponent oSheet1=oDoc.getSheets.getByName("見積書フォーム") oSheet2=oDoc.getSheets.getByName("見積書定義")

 oCel=oSheet2.getCellByPosition(4,21) ItemVol=oCel.Value

 For i=0 to 3 If i=0 Then oCel=oSheet2.getCellByPosition(4,20) Position=oCel.String oCel=oSheet1.getCellRangeByName(Position) BCol(i)=oCel.CellAddress.Column BRow(i)=oCel.CellAddress.Row Else oCel=oSheet2.getCellByPosition(4,i+15) Position=oCel.String oCel=oSheet1.getCellRangeByName(Position) BCol(i)=oCel.CellAddress.Column BRow(i)=oCel.CellAddress.Row End If Next i

 For i=1 to ItemVol*4

 Fld(i)=Dlg2.getControl("TextField" & i) iMod=i Mod 4 iWari=i \ 4



 If iMod=1 Then Str(i)=Fld(i).Text If Str(i)<>"" Then RowPos=iWari+BRow(iMod) oCel=oSheet1.getCellByPosition(BCol(iMod),RowPos) oCel.String=Str(i) End If Elseif iMod=2 Then Val(i)=Fld(i).Text If Val(i)<>0 Then RowPos=iWari+BRow(iMod) oCel=oSheet1.getCellByPosition(BCol(iMod),RowPos) oCel.Value=Val(i) End If Elseif iMod=3 Then Val(i)=Fld(i).Text If Val(i)<>0 Then RowPos=iWari+BRow(iMod) oCel=oSheet1.getCellByPosition(BCol(iMod),RowPos) oCel.Value=Val(i) End If Elseif iMod=0 Then Str(i)=Fld(i).Text If Str(i)<>"" Then RowPos=iWari+BRow(iMod)-1 oCel=oSheet1.getCellByPosition(BCol(iMod),RowPos) oCel.String=Str(i) End If End If

 Next i

 REM=====消費税対応 ChBox=Dlg2.getControl("CheckBox1") If ChBox.State Then oCel=oSheet2.getCellByPosition(2,7) Tax=oCel.Value

 oCel=oSheet2.GetCellByPosition(4,19) Position=oCel.String

 oCel=oSheet1.getCellRangeByName(Position) BCol(0)=oCel.CellAddress.Column BRow(0)=oCel.CellAddress.Row oCel=oSheet1.getCellByPosition(BCol(0),BRow(0)+ItemVol) Sum=oCel.Value TaxS=Sum*Tax

 oCel=oSheet2.GetCellByPosition(4,7) Position=oCel.String oCel=oSheet1.getCellRangeByName(Position) oCel.Value=TaxS

 End If

 REM=====支払条件転記 oCel=oSheet2.getCellByPosition(4,22) Position=oCel.String Fld(41)=Dlg2.getControl("TextField41") Str(41)=Fld(41).Text oCel=oSheet1.getCellRangeByName(Position) oCel.String=Str(41)

 REM=====合計金額計算 oCel=oSheet2.getCellByPosition(4,23) Position=oCel.String oCel=oSheet1.getCellRangeByName(Position) BCol(0)=oCel.CellAddress.Column BRow(0)=oCel.CellAddress.Row oCel=oSheet1.getCellByPosition(BCol(0),BRow(0)-2) Sum=oCel.Value oCel=oSheet1.getCellByPosition(BCol(0),BRow(0)-1) Tax=oCel.Value TaxS=Sum+Tax oCel=oSheet1.getCellByPosition(BCol(0),BRow(0)) oCel.Value=TaxS

 CopySheet Daicho ' マクロ「Daicho」を実行するための追記 Dlg2End

 MsgBox("処理が完了しました。内容は管理台帳.odsに記録されています。") ' 管理台帳に転記したことを知らせるメッセージに変更

 Dlg1Show

 End Sub

これで、作成した見積書は、自動的に同じフォルダーにある「管理台帳.ods」に転記されるようになりました。

クリックで拡大します

試しに上記のようなデータを入力してみると、下のように、管理台帳ファイルに、その入力内容が転記されているのが確認できます。

クリックで拡大します