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

  1： Public Function AddSlipDetail(ByVal SlipID As Variant, _
   　                               ByVal ProductID As Variant, _
   　                               ByVal NUMBER As Variant, _
   　                               ByVal UNITPRICE As Variant, _
   　                               ByVal PRICE As Variant, _
   　                               ByVal MEMO As Variant) As Long
  2：     ' 指定した伝票に明細を加える
  3：     ' 【引数】
  4：     '   SlipID = 明細を加えたい伝票の伝票番号
  5：     '   ProductID = 明細の対象となる製品の製品番号
  6：     '   NUMBER = 数量
  7：     '   UNITPRICE = 製品単価
  8：     '   PRICE = 製品価格
  9：     '   MEMO = 摘要
 10：     ' 【戻り値】
 11：     ' 追加した明細を示すレコードID（IDフィールドに設定された値）
 12：     Dim objContext As ObjectContext
 13：     Dim objDataSlip As DataObj.Slip, objDataSlipDetail As DataObj.SlipDetail
 14：     Dim objDataProduct As DataObj.Product
 15：     Dim old_CUSTOMERID As Variant, old_SUBTOTAL As Variant, old_TAX As Variant
 16：     Dim old_TOTAL As Variant, old_MADEDATE As Variant, old_MADEUSER As Variant
 17：     Dim old_LASTUSER As Variant, old_LASTDATE As Variant
 18：     Dim SUBTOTAL As Currency, TAX As Currency, TOTAL As Currency
 19：     Dim p_PRODUCTNAME As Variant, p_YOMIGANA As Variant, p_PRICE As Variant
 20：     Dim p_STOCK As Variant, p_MEMO As Variant
 21：     Dim p_BACKORDER As Variant, p_MADEUSER As Variant, p_MADEDATE As Variant
 22：     Dim p_LASTUSER As Variant, p_LASTDATE As Variant
 23：     
 24：     ' オブジェクトコンテキストの確認
 25：     Set objContext = GetObjectContext()
 26：     
 27：     ' エラーハンドラの設定
 28：     On Error GoTo ErrHandle
 29：     
 30：     ' 製品の存在を確認
 31：     ' DataObj.Productコンポーネントの実体化
 32：     Set objDataProduct = CreateObject("DataObj.Product")
 33：     If objDataProduct.IsDeleted(ProductID) <> ID_Exists Then
 34：         ' 製品がない
 35：         Err.Raise Errorcode.Err_PRODUCTID, App.Title, _
   　                   "指定された製品は存在しません"
 36：     End If
 37：     
 38：     ' 価格がNULLであった場合には製品情報テーブルから取得した値を使うことにする
 39：     If IsNull(UNITPRICE) And IsNull(PRICE) Then
 40：         ' 製品情報を取得
 41：         objDataProduct.GetRecord ProductID, p_PRODUCTNAME, p_YOMIGANA, p_PRICE, _
   　                                  p_STOCK, p_MEMO, p_BACKORDER, p_MADEUSER, p_MADEDATE, _
   　                                  p_LASTUSER, p_LASTDATE
 42：         UNITPRICE = p_PRICE
 43：         PRICE = UNITPRICE * NUMBER
 44：     End If
 45：     
 46：     ' DataObj.Slipコンポーネントの実体化
 47：     Set objDataSlip = CreateObject("DataObj.Slip")
 48：     
 49：     ' 削除されていないことを確認
 50：     If objDataSlip.IsDeleted(SlipID) <> ID_Exists Then
 51：         Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
   　                   "指定された伝票番号を持つ伝票が見つかりません"
 52：     End If
 53：     
 54：     ' 伝票の現在の状態が承認待ち以上であれば編集は不可
 55：     If objDataSlip.Get_SlipStatus(SlipID) >= RequestingConsent Then
 56：         Err.Raise ERR_CANTUPDATE, App.Title, _
   　                   "承認待ち以上まで進んでいるため変更できません"
 57：     End If
 58：     
 59：     ' 伝票の現在の状態を確認
 60：     objDataSlip.GetRecord_Slip SlipID, old_CUSTOMERID, _
   　                                old_SUBTOTAL, old_TAX, old_TOTAL, _
   　                                old_MADEDATE, old_MADEUSER, _
   　                                old_LASTDATE, old_LASTUSER
 61：     
 62：     ' 変更する権限があるかどうかをチェック
 63：     If Not objContext.IsSecurityEnabled() Then
 64：         ' セキュリティ設定が無効
 65：         Err.Raise ERR_NOSECURE, App.Title, "セキュリティ機構が無効です"
 66：     End If
 67：     
 68：     ' 作成者と呼び出し者が一致するか
 69：     If objContext.Security.GetOriginalCallerName() <> old_MADEUSER Then
 70：         ' 一致しない
 71：         ' SalesManagerロール，SalesAdminロール，AllAdminロールに属するのであれば，
 72：         ' 一致しなくてもよいものとする
 73：         If Not (objContext.IsCallerInRole("SalesManager") Or _
   　                 objContext.IsCallerInRole("SalesAdmin") Or _
   　                 objContext.IsCallerInRole("AllAdmin")) Then
 74：             ' SalesManagerロール，SalesAdminロール，AllAdminロールに属さない
 75：             Err.Raise ERR_NOSECURE, App.Title, _
   　                       "他人が作成した伝票を更新することはできません"
 76：         End If
 77：     End If
 78：     
 79：     ' 明細を追加する
 80：     ' DataObj.SlipDetailコンポーネントの実体化
 81：     Set objDataSlipDetail = CreateObject("DataObj.SlipDetail")
 82：     ' 明細の追加
 83：     AddSlipDetail = objDataSlipDetail.AddRecord( _
   　                         ProductID, NUMBER, UNITPRICE, PRICE, MEMO, SlipID)
 84：     ' 伝票の合計の再計算
 85：     SUBTOTAL = objDataSlipDetail.GetSubTotal(SlipID)
 86：     TAX = SUBTOTAL * 0.05
 87：     TOTAL = SUBTOTAL + TAX
 88：     objDataSlip.SetTotal SlipID, SUBTOTAL, TAX, TOTAL
 89：     
 90：     ' コンポーネントの解放
 91：     Set objDataSlipDetail = Nothing
 92：     Set objDataSlip = Nothing
 93：     Set objDataProduct = Nothing
 94： 
 95：     ' トランザクションをコミット
 96：     objContext.SetComplete
 97：     
 98：     ' オブジェクトコンテキストの解放
 99：     Set objContext = Nothing
100：     
101：     Exit Function
102： 
103： ErrHandle:
104：     ' エラーハンドラ
105：     objContext.SetAbort
106：     Set objContext = Nothing
107：     Set objDataProduct = Nothing
108：     Set objDataSlip = Nothing
109：     Set objDataSlipDetail = Nothing
110：     
111：     ' エラーの再発行
112：     Err.Raise Err.NUMBER, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
113： End Function