List 6-174　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：             SUBTOTAL = 0
 75：             TAX = 0
 76：             TOTAL = 0
 77：             While Not objSlipRec.EOF
 78：                 If Not objSlipRec.Fields("ONEBILLFLAG").Value Then
 79：                     ' 1枚単位の請求書を作るように指定されていないものである
 80：                     ' 請求額に伝票に記載されている額を加える
 81：                     SUBTOTAL = SUBTOTAL + objSlipRec.Fields("SUBTOTAL").Value
 82：                     TAX = TAX + objSlipRec.Fields("TAX").Value
 83：                     TOTAL = TOTAL + objSlipRec.Fields("TOTAL").Value
 84：                 End If
 85：                                 
 86：                 ' 次のレコードに移動する
 87：                 objSlipRec.MoveNext
 88：             Wend
 89：                     
 90：             ' 請求書を作成する
 91：             BillID = objDataBill.AddRecord(objCustomerRec.Fields("ID").Value, _
   　                                            startDate, endDate, _
   　                                            SUBTOTAL, TAX, TOTAL)
 92：             ' 取得した伝票を請求書作成ずみにし，また，請求書と結び付ける
 93：             objSlipRec.MoveFirst
 94：             While Not objSlipRec.EOF
 95：                 If Not objSlipRec.Fields("ONEBILLFLAG").Value Then
 96：                     ' 1枚単位の請求書を作るように指定されていないものである
 97：                     ' 請求書作成ずみにする
 98：                     objDataSlip.Set_MADEBILLFLAG objSlipRec.Fields("ID").Value, True
 99：                     objDataSlip.Set_ACCOUNTINGFLAG objSlipRec.Fields("ID").Value, False, Null
100：                     
101：                     ' 請求書と結び付ける
102：                     objDataSlip.SetBillID objSlipRec.Fields("ID").Value, BillID
103：                 End If
104：                 
105：                 ' 次のレコードに移動する
106：                 objSlipRec.MoveNext
107：             Wend
108：             
109：             ' 以上で1つの顧客に対応する処理は完了
110：             
111：             ' 取得した伝票のレコードセットを解放
112：             objSlipRec.Close
113：             Set objSlipRec = Nothing
114：             
115：             ' 次の顧客の処理に進む
116：             objCustomerRec.MoveNext
117：         Wend
118：         ' 以上で，指定された請求日の処理は完了
119：         
120：         ' 取得した顧客のレコードセットを解放
121：         objCustomerRec.Close
122：         Set objCustomerRec = Nothing
123：     Next
124：     
125：     ' 各種コンポーネントの解放
126：     Set objDataBill = Nothing
127：     Set objDataSlip = Nothing
128：     Set objDataCustomer = Nothing
129：     
130：     ' トランザクションのコミット
131：     objContext.SetComplete
132：     
133：     ' オブジェクトコンテキストの解放
134：     Set objContext = Nothing
135：     
136：     Exit Sub
137：     
138： ErrHandle:
139：     ' エラーハンドラ
140：     objContext.SetAbort
141：     Set objDataCustomer = Nothing
142：     Set objDataSlip = Nothing
143：     Set objDataBill = Nothing
144：     Set objCustomerRec = Nothing
145：     Set objSlipRec = Nothing
146：  
147：     ' エラーの再発行
148：     Err.Raise Err.Number, Err.Source, Err.Description, _
   　               Err.HelpFile, Err.HelpContext
149： End Sub