List 7-135 FormSlipフォームにおいて伝票の状態を変化させる各ボタンが押されたときの処理
1： Private Sub BTN_CANCELREQUESTCONSENT_Click()
2： ' ［承認依頼取消］ボタンが押されたときの処理
3： Dim objSlip As Business.Slip
4： Dim SlipID As Long
5：
6： If MsgBox("承認依頼を取り消してよろしいですか", _
vbYesNo, "承認依頼取消") = vbYes Then
7： ' 承認依頼を取り消す
8： SlipID = g_objRec.Fields("ID").Value
9： On Error GoTo ErrHandle
10： Set objSlip = CreateObject("Business.Slip")
11： objSlip.CancelRequestConsent SlipID
12： Set objSlip = Nothing
13：
14： ' データグリッドの内容を更新する
15： RefreshData
16： g_objRec.MoveFirst
17： g_objRec.Find "ID=" & SlipID, 0, adSearchForward
18： End If
19：
20： Exit Sub
21：
22： ErrHandle:
23： ' エラーハンドラ
24： MsgBox Err.Description, vbOKOnly, "承認依頼取消エラー"
25： Set objSlip = Nothing
26： End Sub
27：
28： Private Sub BTN_CONSENT_Click()
29： ' ［承認］ボタンが押されたときの処理
30： Dim msg As Variant
31： Dim objSlip As Business.Slip
32： Dim SlipID As Long
33：
34： msg = FormInputMsg.GetMessage("承認", "承認時の備考を入力してください")
35：
36： If Not IsNull(msg) Then
37： ' 承認する
38： SlipID = g_objRec.Fields("ID").Value
39： On Error GoTo ErrHandle
40： Set objSlip = CreateObject("Business.Slip")
41： objSlip.ConsentSlip SlipID, msg
42： Set objSlip = Nothing
43：
44： ' データグリッドの内容を更新する
45： RefreshData
46： g_objRec.MoveFirst
47： g_objRec.Find "ID=" & SlipID, 0, adSearchForward
48： End If
49：
50： Exit Sub
51：
52： ErrHandle:
53： ' エラーハンドラ
54： MsgBox Err.Description, vbOKOnly, "承認エラー"
55： Set objSlip = Nothing
56： End Sub
57：
58： Private Sub BTN_CANCELCONSENT_Click()
59： ' ［承認取消］ボタンが押されたときの処理
60： Dim objSlip As Business.Slip
61： Dim SlipID As Long
62：
63： If MsgBox("承認を取り消してよろしいですか", _
vbYesNo, "承認取消") = vbYes Then
64： ' 承認を取り消す
65： SlipID = g_objRec.Fields("ID").Value
66： On Error GoTo ErrHandle
67： Set objSlip = CreateObject("Business.Slip")
68： objSlip.CancelConsentSlip SlipID
69： Set objSlip = Nothing
70：
71： ' データグリッドの内容を更新する
72： RefreshData
73： g_objRec.MoveFirst
74： g_objRec.Find "ID=" & SlipID, 0, adSearchForward
75： End If
76：
77： Exit Sub
78：
79： ErrHandle:
80： ' エラーハンドラ
81： MsgBox Err.Description, vbOKOnly, "承認取消エラー"
82： Set objSlip = Nothing
83： End Sub
84：
85： Private Sub BTN_REJECT_Click()
86： ' ［却下］ボタンが押されたときの処理
87： Dim msg As Variant
88： Dim objSlip As Business.Slip
89： Dim SlipID As Long
90：
91： msg = FormInputMsg.GetMessage("却下", "却下時の備考を入力してください")
92：
93： If Not IsNull(msg) Then
94： ' 却下する
95： SlipID = g_objRec.Fields("ID").Value
96： On Error GoTo ErrHandle
97： Set objSlip = CreateObject("Business.Slip")
98： objSlip.RejectSlip SlipID, msg
99： Set objSlip = Nothing
100：
101： ' データグリッドの内容を更新する
102： RefreshData
103： g_objRec.MoveFirst
104： g_objRec.Find "ID=" & SlipID, 0, adSearchForward
105： End If
106：
107： Exit Sub
108：
109： ErrHandle:
110： ' エラーハンドラ
111： MsgBox Err.Description, vbOKOnly, "却下エラー"
112： Set objSlip = Nothing
113： End Sub
114：
115： Private Sub BTN_CANCELREJECT_Click()
116： ' ［却下取消］ボタンが押されたときの処理
117： Dim objSlip As Business.Slip
118： Dim SlipID As Long
119：
120： If MsgBox("却下を取り消してよろしいですか", _
vbYesNo, "却下取消") = vbYes Then
121： ' 却下を取り消す
122： SlipID = g_objRec.Fields("ID").Value
123： On Error GoTo ErrHandle
124： Set objSlip = CreateObject("Business.Slip")
125： objSlip.CancelConsentSlip SlipID
126： Set objSlip = Nothing
127：
128： ' データグリッドの内容を更新する
129： RefreshData
130： g_objRec.MoveFirst
131： g_objRec.Find "ID=" & SlipID, 0, adSearchForward
132： End If
133：
134： Exit Sub
135：
136： ErrHandle:
137： ' エラーハンドラ
138： MsgBox Err.Description, vbOKOnly, "却下取消エラー"
139： Set objSlip = Nothing
140： End Sub
141：
142： Private Sub BTN_SEND_Click()
143： ' ［発送］ボタンが押されたときの処理
144： Dim msg As Variant
145： Dim objSlip As Business.Slip
146： Dim SlipID As Long
147：
148： msg = FormInputMsg.GetMessage("発送", "発送時の備考を入力してください")
149：
150： If Not IsNull(msg) Then
151： ' 発送する
152： SlipID = g_objRec.Fields("ID").Value
153： On Error GoTo ErrHandle
154： Set objSlip = CreateObject("Business.Slip")
155： objSlip.SendSlip SlipID, msg
156： Set objSlip = Nothing
157：
158： ' データグリッドの内容を更新する
159： RefreshData
160： g_objRec.MoveFirst
161： g_objRec.Find "ID=" & SlipID, 0, adSearchForward
162： End If
163：
164： Exit Sub
165：
166： ErrHandle:
167： ' エラーハンドラ
168： MsgBox Err.Description, vbOKOnly, "承認依頼エラー"
169： Set objSlip = Nothing
170： End Sub
171：
172： Private Sub BTN_CANCELSEND_Click()
173： ' ［発送取消］ボタンが押されたときの処理
174： Dim objSlip As Business.Slip
175： Dim SlipID As Long
176：
177： If MsgBox("発送を取り消してよろしいですか", _
vbYesNo, "発送取消") = vbYes Then
178： ' 発送を取り消す
179： SlipID = g_objRec.Fields("ID").Value
180： On Error GoTo ErrHandle
181： Set objSlip = CreateObject("Business.Slip")
182： objSlip.CancelSendSlip SlipID
183： Set objSlip = Nothing
184： ' データグリッドの内容を更新する
185： RefreshData
186： g_objRec.MoveFirst
187： g_objRec.Find "ID=" & SlipID, 0, adSearchForward
188： End If
189：
190： Exit Sub
191：
192： ErrHandle:
193： ' エラーハンドラ
194： MsgBox Err.Description, vbOKOnly, "発送取消エラー"
195： Set objSlip = Nothing
196： End Sub
197：
198： Private Sub BTN_ACCOUNTING_Click()
199： ' ［経理処理］ボタンが押されたときの処理
200： Dim msg As Variant
201： Dim objSlip As Business.Slip
202： Dim SlipID As Long
203：
204： msg = FormInputMsg.GetMessage("経理処理", "経理処理時の備考を入力してください")
205：
206： If Not IsNull(msg) Then
207： ' 経理処理する
208： SlipID = g_objRec.Fields("ID").Value
209： On Error GoTo ErrHandle
210： Set objSlip = CreateObject("Business.Slip")
211： objSlip.AccountingSlip SlipID, msg
212： Set objSlip = Nothing
213：
214： ' データグリッドの内容を更新する
215： RefreshData
216： g_objRec.MoveFirst
217： g_objRec.Find "ID=" & SlipID, 0, adSearchForward
218： End If
219：
220： Exit Sub
221：
222： ErrHandle:
223： ' エラーハンドラ
224： MsgBox Err.Description, vbOKOnly, "経理処理エラー"
225： Set objSlip = Nothing
226： End Sub
227：
228： Private Sub BTN_CANCELACCOUNTING_Click()
229： ' ［経理処理取消］ボタンが押されたときの処理
230： Dim objSlip As Business.Slip
231： Dim SlipID As Long
232：
233： If MsgBox("経理処理を取り消してよろしいですか", _
vbYesNo, "経理処理取消") = vbYes Then
234： ' 経理処理を取り消す
235： SlipID = g_objRec.Fields("ID").Value
236： On Error GoTo ErrHandle
237： Set objSlip = CreateObject("Business.Slip")
238： objSlip.CancelAccountingSlip SlipID
239： Set objSlip = Nothing
240：
241： ' データグリッドの内容を更新する
242： RefreshData
243： g_objRec.MoveFirst
244： g_objRec.Find "ID=" & SlipID, 0, adSearchForward
245： End If
246：
247： Exit Sub
248：
249： ErrHandle:
250： ' エラーハンドラ
251： MsgBox Err.Description, vbOKOnly, "経理処理取消エラー"
252： Set objSlip = Nothing
253： End Sub
254：
255： Private Sub BTN_MAKEONEBILL_Click()
256： ' ［請求書作成］ボタンが押されたときの処理
257： Dim objBill As Business.Bill
258： Dim SlipID As Long
259：
260： If MsgBox("この伝票の請求書を作成してよろしいですか", _
vbYesNo, "請求書作成") = vbYes Then
261： ' 請求書を作成する
262： SlipID = g_objRec.Fields("ID").Value
263： On Error GoTo ErrHandle
264： Set objBill = CreateObject("Business.Bill")
265： objBill.MakeOneBill SlipID
266： Set objBill = Nothing
267：
268： ' データグリッドの内容を更新する
269： RefreshData
270： g_objRec.MoveFirst
271： g_objRec.Find "ID=" & SlipID, 0, adSearchForward
272： End If
273：
274： Exit Sub
275：
276： ErrHandle:
277： ' エラーハンドラ
278： MsgBox Err.Description, vbOKOnly, "請求書作成エラー"
279： Set objBill = Nothing
280： End Sub