List 6-197 Business.SlipコンポーネントのDeleteBillメソッド

  1： Public Sub DeleteBill(ByVal BillID As Long)
  2：     ' 指定された請求書番号の請求書を削除する
  3：     ' DELETEDFLAGフィールドの値をFalseであればそれをTrueに
  4：     ' DELETEDFLAGフィールドの値がTrueであればレコードそのものを削除する
  5：     ' 【引数】
  6：     '   BillID = 削除したい請求書を特定する請求書番号
  7：     ' 【戻り値】
  8：     '   なし
  9：     Dim objContext As ObjectContext
 10：     Dim objDataBill As DataObj.Bill
 11：     Dim objDataSlip As DataObj.Slip
 12：     Dim objRec As ADODB.Recordset
 13：     Dim ACCOUNTINGUSER As Variant, ACCOUNTINGDATE As Variant
 14：     Dim ACCOUNTINGCOMMENT As Variant
 15：     
 16：     ' オブジェクトコンテキストの取得
 17：     Set objContext = GetObjectContext()
 18：     
 19：     ' エラーハンドラの設定
 20：     On Error GoTo ErrHandle
 21：     
 22：     ' DataObj.Billの実体化
 23：     Set objDataBill = CreateObject("DataObj.Bill")
 24：     
 25：     ' 請求書の状態を判定
 26：     Select Case objDataBill.Get_BillStatus(BillID)
 27：         Case BILL_Deleted
 28：             ' 削除ずみである
 29：             ' このときにはレコードを削除するだけ
 30：             objDataBill.DeleteRecord BillID
 31：         Case BILL_Created
 32：             ' 作成中である
 33：             
 34：             ' （1）請求書に結び付けられている伝票の一覧を取得
 35：             Set objDataSlip = CreateObject("DataObj.Slip")
 36：             Set objRec = objDataSlip.GetRecordsByBillID(BillID)
 37：             
 38：             While Not objRec.EOF
 39：                 ' （2）伝票と請求書との結び付きを解除
 40：                 objDataSlip.SetBillID objRec.Fields("ID").Value, Null
 41：                 ' （3）伝票を請求書作成まえの状態に復元
 42：                 objDataSlip.Set_MADEBILLFLAG objRec.Fields("ID").Value, False
 43：                 objDataSlip.GetRecord_Accounting objRec.Fields("ID").Value, _
   　                                                  ACCOUNTINGUSER, ACCOUNTINGDATE, _
   　                                                  ACCOUNTINGCOMMENT
 44：                 objDataSlip.Set_ACCOUNTINGFLAG objRec.Fields("ID").Value, True, _
   　                                                ACCOUNTINGCOMMENT
 45：                 
 46：                 ' 次のレコードに移動
 47：                 objRec.MoveNext
 48：             Wend
 49：             
 50：             objRec.Close
 51：             Set objRec = Nothing
 52：             
 53：             Set objDataSlip = Nothing
 54：             
 55：             ' （4）請求書の状態を削除ずみに変更
 56：             objDataBill.SetDeletedFlag BillID, True
 57：             
 58：         Case Else
 59：             ' エラー
 60：             Err.Raise ERR_CANTDELETE, App.Title, _
   　                       "請求書がすでに送付されているか入金ずみになっているため操作できません"
 61：     End Select
 62：             
 63：     ' DataObj.Billコンポーネントの解放
 64：     Set objDataBill = Nothing
 65：     
 66：     ' トランザクションのコミット
 67：     objContext.SetComplete
 68：     
 69：     ' オブジェクトコンテキストの解放
 70：     Set objContext = Nothing
 71：     
 72：     Exit Sub
 73： 
 74： ErrHandle:
 75：     ' エラーハンドラ
 76：     objContext.SetAbort
 77：     Set objContext = Nothing
 78：     Set objDataBill = Nothing
 79：     Set objDataSlip = Nothing
 80：     Set objRec = Nothing
 81： 
 82：     ' エラーの再発行
 83：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 84： End Sub