List 6-110 Business.SlipコンポーネントのUpdateSlipメソッド
1： Public Function UpdateSlip(ByVal SlipID As Long, _
ByVal CUSTOMERID As Variant, _
ByVal ONEBILLFLAG As Variant, _
ByVal DIVISION As Variant, _
ByVal PERSON As Variant, _
ByVal DELIVERDATE As Variant, _
ByVal SENT_ADDR As Variant, _
ByVal SENT_TEL As Variant, _
ByVal MEMO As Variant)
2： ' 伝票情報を更新する
3： ' 【引数】
4： ' SlipID = 編集の対象となる伝票を特定する伝票番号
5： ' CustomerID = 対象となる顧客を示す顧客番号
6： ' ONEBILLFLAG = この伝票に対して1枚の請求書を作るならばTrue，
7： ' 別の伝票と合わせて月次の請求書を作るならばFalse
8： ' DIVISION = 顧客側の部署名
9： ' PERSON = 顧客側の担当者名
10： ' DELIVERDATE = 納入予定日
11： ' SENT_ADDR = 発送先の住所
12： ' SENT_TEL = 発送先の電話番号
13： ' MEMO = 摘要
14： ' 【戻り値】
15： ' なし
16： Dim objContext As ObjectContext
17： Dim objDataSlip As DataObj.Slip, objDataSlipInformation As DataObj.SlipInformation
18： Dim objDataCustomer As DataObj.Customer
19： Dim old_CUSTOMERID As Variant, old_SUBTOTAL As Variant, old_TAX As Variant
20： Dim old_TOTAL As Variant, old_MADEDATE As Variant, old_MADEUSER As Variant
21： Dim old_LASTUSER As Variant, old_LASTDATE As Variant
22： Dim old_ONEBILLFLAG As Variant, old_BILLID As Variant, old_BILLDATE As Variant
23： Dim SlipStatus As DataObj.SlipStatus
24： Dim old_DIVISION As Variant, old_PERSON As Variant, old_DELIVERDATE As Variant
25： Dim old_SENT_ADDR As Variant, old_SENT_TEL As Variant, old_MEMO As Variant
26： Dim ChangeFlag As Boolean
27： Dim RecordID As Long
28：
29： ' オブジェクトコンテキストの取得
30： Set objContext = GetObjectContext()
31：
32： ' エラーハンドラの設定
33： On Error GoTo ErrHandle
34：
35： ' DataObj.Slipコンポーネントの実体化
36： Set objDataSlip = CreateObject("DataObj.Slip")
37：
38： ' 削除されていないことを確認
39： If objDataSlip.IsDeleted(SlipID) <> ID_Exists Then
40： Err.Raise Errorcode.Err_NOTFOUND, App.Title, _
"指定された伝票番号を持つ伝票が見つかりません"
41： End If
42：
43： ' 現在の伝票の情報を取得
44： objDataSlip.GetRecord_Slip SlipID, old_CUSTOMERID, _
old_SUBTOTAL, old_TAX, old_TOTAL, _
old_MADEDATE, old_MADEUSER, _
old_LASTDATE, old_LASTUSER
45： objDataSlip.GetRecord_Bill SlipID, old_BILLID, old_BILLDATE, _
old_ONEBILLFLAG
46： ' 変更する権限があるかどうかをチェック
47： If Not objContext.IsSecurityEnabled() Then
48： ' セキュリティ設定が無効
49： Err.Raise ERR_NOSECURE, App.Title, _
"セキュリティ機構が無効です"
50： End If
51：
52： ' 作成者と呼び出し者が一致するか
53： If objContext.Security.GetOriginalCallerName() <> old_MADEUSER Then
54： ' 一致しない
55： ' SalesManagerロール，SalesAdminロール，AllAdminロールに属するのであれば，
56： ' 一致しなくてもよいものとする
57： If Not (objContext.IsCallerInRole("SalesManager") Or _
objContext.IsCallerInRole("SalesAdmin") Or _
objContext.IsCallerInRole("AllAdmin")) Then
58： ' SalesManagerロール，SalesAdminロール，AllAdminロールに属さない
59： Err.Raise ERR_NOSECURE, App.Title, _
"他人が作成した伝票を更新することはできません"
60： End If
61： End If
62：
63：
64： ' 伝票の現在の状態を取得
65： SlipStatus = objDataSlip.Get_SlipStatus(SlipID)
66：
67： ' CUSTOMERIDフィールドの値を更新
68： If CUSTOMERID <> old_CUSTOMERID Then
69： ' 更新できるのは，SlipStatusがRequestingConsentよりも小さいときだけ
70： If SlipStatus >= RequestingConsent Then
71： Err.Raise ERR_CANTUPDATE, App.Title, _
"承認ずみなので顧客の変更はできません"
72： End If
73： ' 顧客が存在することを確認
74： ' DataObj.Customerコンポーネントの実体化
75： Set objDataCustomer = CreateObject("DataObj.Customer")
76： If objDataCustomer.IsDeleted(CUSTOMERID) <> ID_Exists Then
77： ' 顧客がいない
78： Err.Raise Errorcode.Err_CUSTOMERID, App.Title, _
"指定された顧客は存在しません"
79： End If
80： Set objDataCustomer = Nothing
81： ' 更新
82： objDataSlip.Update_CUSTOMERID SlipID, CUSTOMERID
83： End If
84：
85： ' ONEBILLFLAGフィールドの値を更新
86： If ONEBILLFLAG <> old_ONEBILLFLAG Then
87： ' 更新できるのは，SlipStatusがAccountedよりも小さいときだけ
88： If SlipStatus >= Accounted Then
89： Err.Raise ERR_CANTUPDATE, App.Title, _
"経理処理ずみなので請求書の設定変更はできません"
90： End If
91： ' 更新
92： objDataSlip.Update_ONEBILLFLAG SlipID, ONEBILLFLAG
93： End If
94：
95： ' DataObj.SlipInformationコンポーネントの実体化
96： Set objDataSlipInformation = CreateObject("DataObj.SlipInformation")
97：
98： ' 現在の設定値を取得
99： RecordID = objDataSlipInformation.GetRecord(SlipID, old_DIVISION, _
old_PERSON, old_DELIVERDATE, _
old_SENT_ADDR, old_SENT_TEL, old_MEMO, _
old_MADEDATE, old_MADEUSER, _
old_LASTDATE, old_LASTUSER)
100： ' 伝票追加情報を変更
101： ChangeFlag = False
102：
103： ' DIVISIONの内容を設定しようとしているか
104： If DIVISION <> old_DIVISION Or (IsNull(DIVISION) Xor IsNull(old_DIVISION)) Then
105： ChangeFlag = True
106： End If
107： ' PERSONの内容を設定しようとしているか
108： If PERSON <> old_PERSON Or (IsNull(PERSON) Xor IsNull(old_PERSON)) Then
109： ChangeFlag = True
110： End If
111： ' DELIVERDATEの内容を設定しようとしているか
112： If DELIVERDATE <> old_DELIVERDATE Or (IsNull(DELIVERDATE) Xor IsNull(old_DELIVERDATE)) Then
113： ChangeFlag = True
114： End If
115： ' SENT_ADDRの内容を設定しようとしているか
116： If SENT_ADDR <> old_SENT_ADDR Or (IsNull(SENT_ADDR) Xor IsNull(old_SENT_ADDR)) Then
117： ChangeFlag = True
118： End If
119： ' SENT_TELの内容を設定しようとしているか
120： If SENT_TEL <> old_SENT_TEL Or (IsNull(SENT_TEL) Xor IsNull(old_SENT_TEL)) Then
121： ChangeFlag = True
122： End If
123： ' MEMOの内容を設定しようとしているか
124： If MEMO <> old_MEMO Or (IsNull(MEMO) Xor IsNull(old_MEMO)) Then
125： ChangeFlag = True
126： End If
127：
128： ' いずれかの情報を変更しようとしていれば，
129： ' 伝票追加情報テーブル内のレコードを更新
130： If ChangeFlag Then
131： ' 変更できるのは伝票の状態がSendより小さいとき
132： If SlipStatus >= Send Then
133： Err.Raise ERR_CANTUPDATE, App.Title, _
"すでに製品が発送されているため，伝票の情報を変更することはできません"
135： End If
136： ' 既存の伝票追加情報テーブル内のレコードを削除
137： objDataSlipInformation.SetDeleted RecordID
138： ' 新しい情報に設定したレコードを追加する
139： objDataSlipInformation.AddRecord SlipID, DIVISION, PERSON, _
DELIVERDATE, SENT_ADDR, SENT_TEL, MEMO
140： End If
141：
142： ' 各種コンポーネントの解放
143： Set objDataSlipInformation = Nothing
144： Set objDataSlip = Nothing
145： Set objDataCustomer = Nothing
146：
147： ' トランザクションをコミット
148： objContext.SetComplete
149：
150： ' オブジェクトコンテキストの解放
151： Set objContext = Nothing
152：
153： Exit Function
154：
155： ErrHandle:
156： ' エラーハンドラ
157： objContext.SetAbort
158： Set objContext = Nothing
159： Set objDataCustomer = Nothing
160： Set objDataSlip = Nothing
161： Set objDataSlipInformation = Nothing
162：
163： ' エラーの再発行
164： Err.Raise Err.NUMBER, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
165： End Function