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

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