LibreOffice(Calc)でのマクロ : 13. 見積書作成 (6) – 見積書フォームデータのクリア

ユーザー Mr. Union の写真
2014年7月6日 -- Mr. Union

ところで、このまま見積書フォームを何度か使っていると、前のデータが残ってしまう、という問題が起こります。

例えば、以下のように明細に2つの品目が記載される見積書を作ったとします。

クリックで拡大します

続けて、もう一つの見積書を作るとして、以下のように、今度は1つの品目だけを入れたいとしても、今のままでは前回入力した「2つ目の品目(上記の例では「メンテナンス」という品目)」が残ってしまうことになります。

クリックで拡大します

これでは、正しい見積書作成ができません。そこで、以下の通り、既に入力したデータをクリアするマクロを作ってみます。

Sub ContentsClear

 Dim oDoc As Object Dim oSheet1 As Object Dim oSheet2 As Object Dim oCel As Object Dim oRange As Object Dim oCursor As Object Dim MaxRow As Long Dim i As Long Dim ColPos As Integer Dim RowPos As Integer Dim ItemVol As Integer Dim Position As String Dim ii As Long Dim iii As Long

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

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

 For i=1 to MaxRow oCel = oSheet1.getCellByPosition(4,i) Position=oCel.String If Position<>"" Then If i<>19 Then ' 「金額」欄は計算式が入っているのでクリアしない if i=21 Then ' 品目数を取得 oCel = oSheet1.getCellByPosition(4,i) ItemVol=oCel.Value For ii=1 to ItemVol For iii=16 to 20 If iii<>19 Then ' 「金額」欄は計算式が入っているのでクリアしない oCel=oSheet1.getCellByPosition(4,iii) ' 品目数分だけ明細をクリア Position=oCel.String oCel=oSheet2.getCellRangeByName(Position) ColPos=oCel.CellAddress.Column RowPos=oCel.CellAddress.Row oCel=oSheet2.getCellByPosition(ColPos,RowPos+ii-1) oCel.String="" End If Next iii Next

  ii Else

 ' 明細以外の記載項目をクリア oCel=oSheet1.getCellByPosition(4,i) Position=oCel.String oCel=oSheet2.getCellRangeByName(Position) oCel.String="" End If End If End If

 Next i

 End Sub

基本的に、「見積書定義」シートにある座標をチェックして、その座標のセルの 中身を消していくことになりますが、一つだけ厄介なのが、明細の項目です。明 細の項目については、1品目目の座標が分かっているだけで、あとは「品目数」分だけ、下の行を消していくということになります。それを実行しているのが、 以下の記述分です。

For ii=1 to ItemVol ' 品目数分だけ繰り返す For iii=16 to 20 If iii<>19 Then ' 「品目」、「単価」、「数量」、「備考」の処理 oCel=oSheet1.getCellByPosition(4,iii) Position=oCel.String oCel=oSheet2.getCellRangeByName(Position) ' 1品目目のセル座標 ColPos=oCel.CellAddress.Column ' 1品目目セル座標の列数を取得 RowPos=oCel.CellAddress.Row ' 1品目目セル座標の行数を取得 oCel=oSheet2.getCellByPosition(ColPos,RowPos+ii-1) ' 全品目のセル座標を指定(行番号を追加する) oCel.String="" ' セルの中身を空欄にする End If Next iii Next ii

これにより、「見積書定義」シートに指定されている項目について、「見積書フォーム」に記入されている欄が全て空白になります。この処 理を、 「Dialog1」が表示されるときに実行されるようにするため、「Dlg1Show」のマクロを以下のように書き換えておきましょう。

Sub Dlg1Show Dim Fld(1 to 4) As Object Dim ADate As Date

 ContentsClear ' 「見積書定義」シートで指定した項目の欄が空白になる

 DialogLibraries.LoadLibrary("Standard") Dlg1=CreateUnoDialog(DialogLibraries.Standard.Dialog1)

 Fld(1)=Dlg1.getControl("TextField1") Fld(4)=Dlg1.getControl("TextField4")

 ADate=DateAdd ("m", 3, Date) Fld(1).Text=Format(Date,"yyyy年m月d日") Fld(4).Text=Format(ADate,"yyyy年m月d日")

 Dlg1.execute()

 End Sub

これで、毎回「Dialog1」が表示されるたびに、「見積書フォーム」の各欄が空白になるので、常に新しい状態で見積書の記入ができるようになります。

サンプルファイルはこちら