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

  1： Public Sub AccountingSlip(ByVal SlipID As Long, _
   　                           ByVal Comment As Variant)
  2：     ' 指定された伝票を経理処理ずみにする
  3：     ' 【引数】
  4：     '   SlipID = 経理処理ずみとしたい伝票の伝票番号
  5：     '   Comment = 経理処理ずみにするときのコメント
  6：     ' 【戻り値】
  7：     '   なし
  8：     Dim objContext As ObjectContext
  9：     Dim objDataSlip As DataObj.Slip
 10：     Dim SlipStatus As SlipStatus
 11：     
 12：     ' オブジェクトコンテキストの取得
 13：     Set objContext = GetObjectContext()
 14：     
 15：     ' エラーハンドラの設定
 16：     On Error GoTo ErrHandle
 17：     
 18：     ' DataObj.Slipコンポーネントの実体化
 19：     Set objDataSlip = CreateObject("DataObj.Slip")
 20：     
 21：     ' 伝票が存在することを確認
 22：     If objDataSlip.IsDeleted(SlipID) <> ID_Exists Then
 23：         ' 伝票が存在しない
 24：         Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
   　                   "指定された伝票は存在しません"
 25：     End If
 26：     
 27：     ' 伝票の状態を取得
 28：     SlipStatus = objDataSlip.Get_SlipStatus(SlipID)
 29：     If (SlipStatus <> Send) Then
 30：         ' 伝票が発送ずみでない
 31：         Err.Raise BusinessError.ERR_CANTUPDATE, App.Title, _
   　                   "その伝票は発送ずみではありません"
 32：     End If
 33：     
 34：     ' 権限の確認
 35：     If Not objContext.IsSecurityEnabled() Then
 36：         ' セキュリティ設定が無効
 37：         Err.Raise ERR_NOSECURE, App.Title, _
   　                   "セキュリティ機構が無効です"
 38：     End If
 39：     
 40：     If Not (objContext.IsCallerInRole("Accounting") Or _
   　             objContext.IsCallerInRole("AccountingAdmin") Or _
   　             objContext.IsCallerInRole("AllAdmin")) Then
 41：         ' Accounting，AccountingAdmin，AllAdminロールに属さない
 42：         Err.Raise ERR_NOSECURE, App.Title, _
   　                   "経理処理する権限がありません"
 43：     End If
 44：     
 45：     ' ACCOUNTINGFLAGフィールドをTrueにする
 46：     objDataSlip.Set_ACCOUNTINGFLAG SlipID, True, Comment
 47：     ' SENDFLAGフィールドをFalseにする
 48：     objDataSlip.Set_SENDFLAG SlipID, False, Null
 49：     
 50：     ' コンポーネントの解放
 51：     Set objDataSlip = Nothing
 52：     
 53：     ' トランザクションのコミット
 54：     objContext.SetComplete
 55：     
 56：     ' オブジェクトコンテキストの解放
 57：     Set objContext = Nothing
 58：     
 59：     Exit Sub
 60：     
 61： ErrHandle:
 62：     ' エラーハンドラ
 63：     objContext.SetAbort
 64：     Set objDataSlip = Nothing
 65：     
 66：     ' エラーの再発行
 67：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
 68： End Sub