List 7-195 Business.Billコンポーネントの訂正したMakeBillsメソッド（訂正箇所は赤色で示した）
1： Public Sub MakeBills(ByVal billdate As Date)
2： ' 指定された日付よりも小さい日付の伝票を集計し，請求書を作成する
3： ' 【引数】
4： ' billdate = 集計したい伝票の締め日
5： ' 【戻り値】
6： ' なし
7： Dim objContext As ObjectContext
8： Dim objDataCustomer As DataObj.Customer
9： Dim objDataBill As DataObj.Bill
10： Dim objDataSlip As DataObj.Slip
11： Dim objCustomerRec As ADODB.Recordset
12： Dim objSlipRec As ADODB.Recordset
13： Dim startBillDay As Long, endBillDay As Long
14： Dim nextMonth As Date
15： Dim bdate As Date
16： Dim SUBTOTAL As Currency, TAX As Currency, TOTAL As Currency
17： Dim BillID As Long
18： Dim startDate As Date, endDate As Date
19：
20： ' オブジェクトコンテキストの取得
21： Set objContext = GetObjectContext()
22：
23： ' エラーハンドラの設定
24： On Error GoTo ErrHandle
25：
26： ' 引数billdateの時刻部分を捨てる
27： billdate = DateValue(billdate)
28：
29： ' 請求期間を算出
30： startDate = DateAdd("m", -1, billdate)
31： startDate = DateAdd("d", 1, startDate)
32： endDate = billdate
33：
34： ' 請求書の締め日を算出
35： startBillDay = Day(billdate)
36： ' 該当月の最終日を算出
37： ' 翌月の日を算出
38： nextMonth = DateAdd("m", 1, billdate)
39： ' 翌月の月の頭から1日引いた日が該当月の最終日である
40： endBillDay = Day(DateAdd("d", -1, _
DateSerial(Year(nextMonth), Month(nextMonth), 1)))
41：
42： If endBillDay = startBillDay Then
43： ' 該当月の最終日である
44： ' この場合には，startBillDayから締め日が31日に設定されている顧客までを
45： ' 集計の対象とする
46： endBillDay = 31
47： Else
48： ' 該当月の最終日ではない
49： ' この場合には，startBillDayに締め日が設定されている顧客だけを
50： ' 集計の対象とする
51： endBillDay = startBillDay
52： End If
53：
54： ' DataObj.Customerコンポーネントを実体化
55： Set objDataCustomer = CreateObject("DataObj.Customer")
56： ' DataObj.Slipコンポーネントを実体化
57： Set objDataSlip = CreateObject("DataObj.Slip")
58： ' DataObj.Billコンポーネントを実体化
59： Set objDataBill = CreateObject("DataObj.Bill")
60：
61： ' startBillDayからendBillDayまでくり返す。
62： ' これにより，たとえば，閏年ではない2月28日が指定された場合には，
63： ' 上記までの処理において，startBillDay変数に28が，endBillDay変数に31が設定されるため，
64： ' 締め日が28日，29日，30日，31日に設定されている顧客に対して集計することになる
65： For bdate = startBillDay To endBillDay
66： ' 指定された締め日の顧客を抜き出す
67： Set objCustomerRec = objDataCustomer.GetCustomersByBillDay(bdate)
68： ' それぞれの顧客に対し，伝票の集計処理をする
69： While Not objCustomerRec.EOF
70： ' objCustomerRec.Fields("CUSTOMERID").Valueの値が取引先に
71： ' なっていてかつ経理処理ずみの伝票の一覧を取得する
72： Set objSlipRec = objDataSlip.GetRecords(Null, Null, Null, Null, True, _
FILTER_SLIP_ACCOUNTED, False, _
objCustomerRec.Fields("ID").Value)
73： ' 取得した伝票に対して請求書を作成する処理をする
74： If Not objSlipRec.Eof Then ' 訂正
75： SUBTOTAL = 0
76： TAX = 0
77： TOTAL = 0
78： While Not objSlipRec.EOF
79： If Not objSlipRec.Fields("ONEBILLFLAG").Value Then
80： ' 1枚単位の請求書を作るように指定されていないものである
81： ' 請求額に伝票に記載されている額を加える
82： SUBTOTAL = SUBTOTAL + objSlipRec.Fields("SUBTOTAL").Value
83： TAX = TAX + objSlipRec.Fields("TAX").Value
84： TOTAL = TOTAL + objSlipRec.Fields("TOTAL").Value
85： End If
86：
87： ' 次のレコードに移動する
88： objSlipRec.MoveNext
89： Wend
90：
91： ' 請求書を作成する
92： BillID = objDataBill.AddRecord(objCustomerRec.Fields("ID").Value, _
startDate, endDate, _
SUBTOTAL, TAX, TOTAL)
93： ' 取得した伝票を請求書作成ずみにし，また，請求書と結び付ける
94： objSlipRec.MoveFirst
95： While Not objSlipRec.EOF
96： If Not objSlipRec.Fields("ONEBILLFLAG").Value Then
97： ' 1枚単位の請求書を作るように指定されていないものである
98： ' 請求書作成ずみにする
99： objDataSlip.Set_MADEBILLFLAG objSlipRec.Fields("ID").Value, True
100： objDataSlip.Set_ACCOUNTINGFLAG objSlipRec.Fields("ID").Value, False, Null
101：
102： ' 請求書と結び付ける
103： objDataSlip.SetBillID objSlipRec.Fields("ID").Value, BillID
104： End If
105：
106： ' 次のレコードに移動する
107： objSlipRec.MoveNext
108： Wend
109： End If '訂正
110： ' 以上で1つの顧客に対応する処理は完了
111：
112： ' 取得した伝票のレコードセットを解放
113： objSlipRec.Close
114： Set objSlipRec = Nothing
115：
116： ' 次の顧客の処理に進む
117： objCustomerRec.MoveNext
118： Wend
119： ' 以上で，指定された請求日の処理は完了
120：
121： ' 取得した顧客のレコードセットを解放
122： objCustomerRec.Close
123： Set objCustomerRec = Nothing
124： Next
125：
126： ' 各種コンポーネントの解放
127： Set objDataBill = Nothing
128： Set objDataSlip = Nothing
129： Set objDataCustomer = Nothing
130：
131： ' トランザクションのコミット
132： objContext.SetComplete
133：
134： ' オブジェクトコンテキストの解放
135： Set objContext = Nothing
136：
137： Exit Sub
138：
139： ErrHandle:
140： ' エラーハンドラ
141： objContext.SetAbort
142： Set objDataCustomer = Nothing
143： Set objDataSlip = Nothing
144： Set objDataBill = Nothing
145： Set objCustomerRec = Nothing
146： Set objSlipRec = Nothing
147：
148： ' エラーの再発行
149： Err.Raise Err.Number, Err.Source, Err.Description, _
Err.HelpFile, Err.HelpContext
150： End Sub