List 7-136 FormSlipFilterフォームのSetFilterプロシージャなど
1： Private OkFlag As Boolean
2：
3： Public Function SetFilter(start_MADEDATE As Variant, end_MADEDATE As Variant, _
start_DELIVERDATE As Variant, end_DELIVERDATE As Variant, _
IncludeOtherMade As Boolean, filterSlip As FILTER_SLIP, _
IncludeDeleted As Boolean, CustomerID As Long) As Boolean
4： ' 絞り込み設定のウィンドウを表示し，設定された情報を返す
5： ' 【引数】
6： ' start_MADEDATE = 起票日による絞り込みの開始日
7： ' end_MADEDATE = 起票日による絞り込みの終了日
8： ' start_DELIVERDATE = 納入予定日による絞り込みの開始日
9： ' end_MADEDATE = 納入予定日による絞り込みの終了日
10： ' IncludeOtherMade = 他人が作った伝票も含むかどうかのフラグ
11： ' filterSlip = 伝票の状態による絞り込みを設定するFILTER_SLIP列挙型の組み合わせ
12： ' IncludeDeleted = 削除ずみを含むかどうかのフラグ
13： ' CustomerID = 顧客による絞り込みをするとき，絞り込む顧客番号（-1のときには絞り込みなし）
14： ' いずれの引数も，メソッドから戻り，かつ，ユーザーが［OK］ボタンを押したときには
15： ' ユーザーが設定ウィンドウで設定した内容に合致するよう書き換えられる
16： ' 【戻り値】
17： ' ユーザーが［OK］ボタンを押してウィンドウを閉じたならばTrue
18： ' そうでなければFalse
19：
20： ' 現在の設定を設定ウィンドウに反映させる
21： If filterSlip And FILTER_SLIP_CREATING Then
22： CHK_CREATING.Value = 1
23： Else
24： CHK_CREATING.Value = 0
25： End If
26： If filterSlip And FILTER_SLIP_REQUESTINGCONSENT Then
27： CHK_REQUESTINGCONSENT.Value = 1
28： Else
29： CHK_REQUESTINGCONSENT.Value = 0
30： End If
31： If filterSlip And FILTER_SLIP_CONSENTED Then
32： CHK_CONSENTED.Value = 1
33： Else
34： CHK_CONSENTED.Value = 0
35： End If
36： If filterSlip And FILTER_SLIP_REJECTED Then
37： CHK_REJECTED.Value = 1
38： Else
39： CHK_REJECTED.Value = 0
40： End If
41： If filterSlip And FILTER_SLIP_SEND Then
42： CHK_SEND.Value = 1
43： Else
44： CHK_SEND.Value = 0
45： End If
46： If filterSlip And FILTER_SLIP_ACCOUNTED Then
47： CHK_ACCOUNTED.Value = 1
48： Else
49： CHK_ACCOUNTED.Value = 0
50： End If
51： If filterSlip And FILTER_SLIP_FINISH Then
52： CHK_FINISH.Value = 1
53： Else
54： CHK_FINISH.Value = 0
55： End If
56：
57： If Not IsNull(start_MADEDATE) Then
58： TXT_startMADEDATE.Text = FormatDateTime(start_MADEDATE, vbShortDate)
59： Else
60： TXT_startMADEDATE.Text = ""
61： End If
62：
63： If Not IsNull(end_MADEDATE) Then
64： TXT_endMADEDATE.Text = FormatDateTime(end_MADEDATE, vbShortDate)
65： Else
66： TXT_endMADEDATE.Text = ""
67： End If
68：
69： If Not IsNull(start_DELIVERDATE) Then
70： TXT_startDELIVERDATE.Text = FormatDateTime(start_DELIVERDATE, vbShortDate)
71： Else
72： TXT_startDELIVERDATE.Text = FormatDateTime(start_DELIVERDATE, vbShortDate)
73： End If
74：
75： If Not IsNull(end_DELIVERDATE) Then
76： TXT_endDELIVERDATE.Text = FormatDateTime(end_DELIVERDATE, vbShortDate)
77： Else
78： TXT_endDELIVERDATE.Text = FormatDateTime(end_DELIVERDATE, vbShortDate)
79： End If
80：
81： If IncludeOtherMade Then
82： CHK_INCLUDEOTHERMADE.Value = 1
83： Else
84： CHK_INCLUDEOTHERMADE.Value = 0
85： End If
86：
87： If IncludeDeleted Then
88： CHK_IncludeDeleted.Value = 1
89： Else
90： CHK_IncludeDeleted.Value = 0
91： End If
92：
93： FillCombo CustomerID
94： If CustomerID <> -1 Then
95： CHK_CUSTOMER.Value = 1
96： COMBO_CUSTOMER.Enabled = True
97： Else
98： CHK_CUSTOMER.Value = 0
99： COMBO_CUSTOMER.Enabled = False
100： End If
101：
102： ' フォームを表示する
103： OkFlag = False
104： Me.Show 1
105：
106： ' ウィンドウが閉ざされたときの処理
107： If OkFlag Then
108： ' ［OK］ボタンが押された
109： ' 設定ウィンドウにおいてユーザーが選択した内容を引数に反映する
110：
111： filterSlip = 0
112： If CHK_CREATING.Value = 1 Then
113： filterSlip = filterSlip Or FILTER_SLIP_CREATING
114： End If
115： If CHK_REQUESTINGCONSENT.Value = 1 Then
116： filterSlip = filterSlip Or FILTER_SLIP_REQUESTINGCONSENT
117： End If
118： If CHK_CONSENTED.Value = 1 Then
119： filterSlip = filterSlip Or FILTER_SLIP_CONSENTED
120： End If
121： If CHK_REJECTED.Value = 1 Then
122： filterSlip = filterSlip Or FILTER_SLIP_REJECTED
123： End If
124： If CHK_SEND.Value = 1 Then
125： filterSlip = filterSlip Or FILTER_SLIP_SEND
126： End If
127： If CHK_ACCOUNTED.Value = 1 Then
128： filterSlip = filterSlip Or FILTER_SLIP_ACCOUNTED
129： End If
130： If CHK_FINISH.Value = 1 Then
131： filterSlip = filterSlip Or FILTER_SLIP_FINISH
132： End If
133：
134： If TXT_startMADEDATE.Text <> "" Then
135： start_MADEDATE = TXT_startMADEDATE.Text
136： Else
137： start_MADEDATE = Null
138： End If
139：
140： If TXT_endMADEDATE.Text <> "" Then
141： end_MADEDATE = TXT_endMADEDATE.Text
142： Else
143： end_MADEDATE = Null
144： End If
145：
146： If TXT_startDELIVERDATE.Text <> "" Then
147： start_DELIVERDATE = TXT_startDELIVERDATE.Text
148： Else
149： start_DELIVERDATE = Null
150： End If
151：
152： If TXT_endDELIVERDATE.Text <> "" Then
153： end_DELIVERDATE = TXT_endDELIVERDATE.Text
154： Else
155： end_DELIVERDATE = Null
156： End If
157：
158： If CHK_INCLUDEOTHERMADE.Value = 1 Then
159： IncludeOtherMade = True
160： Else
161： IncludeOtherMade = False
162： End If
163：
164： If CHK_IncludeDeleted.Value = 1 Then
165： IncludeDeleted = True
166： Else
167： IncludeDeleted = False
168： End If
169：
170： If CHK_CUSTOMER.Value = 1 Then
171： Dim listIndex
172： listIndex = COMBO_CUSTOMER.listIndex
173： If listIndex = -1 Then
174： MsgBox "顧客名が指定されていません。顧客による絞り込みは無視されます", _
vbOKOnly, "顧客の設定エラー"
175： CustomerID = -1
176： Else
177： CustomerID = COMBO_CUSTOMER.ItemData(listIndex)
178： End If
179： Else
180： CustomerID = -1
181： End If
182： End If
183：
184： ' 自分自身を閉じ，戻り値を設定して終了
185： Me.Hide
186： SetFilter = OkFlag
187： End Function
188：
189： Private Sub FillCombo(SetFocusID As Long)
190： ' 顧客名を格納するCOMBO_CUSTOMERコンボボックスに
191： ' 現在登録されている顧客一覧を登録する
192： ' 【引数】
193： ' SetFucusID = コンボボックスに入れたあと，この引数に指定した
194： ' レコードIDを持つものが選択状態になる
195： ' 【戻り値】
196： ' なし
197： Dim objCustomer As Business.Customer
198： Dim objRec As ADODB.Recordset
199： Dim SelIndex As Long
200：
201： ' 顧客名の一覧を得る
202： On Error GoTo ErrHandle
203：
204： Set objCustomer = CreateObject("Business.Customer")
205： Set objRec = objCustomer.GetCustomers
206：
207： ' 取得した顧客名の一覧をコンボボックスに加える
208： COMBO_CUSTOMER.Clear
209：
210： SelIndex = -1
211：
212： While Not objRec.EOF
213： If objRec.Fields("DELETEDFLAG").Value = False Then
214： ' 削除ずみでなければコンボボックスに追加する
215： COMBO_CUSTOMER.AddItem objRec.Fields("NAME").Value
216： COMBO_CUSTOMER.ItemData(COMBO_CUSTOMER.NewIndex) = objRec.Fields("ID").Value
217：
218： ' 引数に指定されたのと同じ顧客番号があれば，そのインデックスを記録しておく
219： If objRec.Fields("ID").Value = SetFocusID Then
220： SelIndex = COMBO_CUSTOMER.NewIndex
221： End If
222： End If
223： objRec.MoveNext
224： Wend
225：
226： ' 引数で指定された顧客番号を選択状態にする
227： COMBO_CUSTOMER.listIndex = SelIndex
228：
229： Set objRec = Nothing
230： Set objCustomer = Nothing
231：
232： Exit Sub
233：
234： ErrHandle:
235： ' エラーハンドラ
236： MsgBox Err.Description, vbOKOnly, "絞り込みの設定エラー"
237： Set objCustomer = Nothing
238： Set objRec = Nothing
239： End Sub
240：
241： Private Sub BTN_CANCEL_Click()
242： ' ［キャンセル］ボタンが押されたときの処理
243： OkFlag = False
244： Me.Hide
245： End Sub
246：
247： Private Sub BTN_OK_Click()
248： ' ［OK］ボタンが押されたときの処理
249： OkFlag = True
250： Me.Hide
251： End Sub
252：
253： Private Sub CHK_CUSTOMER_Click()
254： If CHK_CUSTOMER.Value = 1 Then
255： COMBO_CUSTOMER.Enabled = True
256： Else
257： COMBO_CUSTOMER.Enabled = False
258： End If
259： End Sub