Option Compare Database
Option Explicit

'作業テーブルと元テーブルの読み込み、書き込みに使用
Public WorkTableName As String
'編集対象のテーブル名
Public WorkYear As Integer
'編集する年

'作業レコードの読み込み、書き込みに使用
Public WorkID As Long
'編集するレコードのID
Public Work日付 As Date
'編集するレコードの日付
Public Work科目番号 As Long
'編集するレコードの科目番号
Public Work摘要1 As String
'編集するレコードの摘要1
Public Work摘要2 As String
'編集するレコードの摘要2
Public Work入金 As Long
'編集するレコードの金額
Public Work出金 As Long
'編集するレコードの入

Dim db As Database
Dim rs As Recordset
Dim rs1 As Recordset
Dim rs2 As Recordset
'
Sub CreateTable(strTableName As String)
'新規帳簿テーブルの作成
Set db = CurrentDb
CurrentDb.Execute "CREATE TABLE " & strTableName & _
"(ID COUNTER, " & _
" 日付 DATETIME, " & _
" 科目番号 LONG, " & _
" 摘要1 TEXT(50), " & _
" 摘要2 TEXT(50), " & _
" 入金 LONG, " & _
" 出金 LONG );"
Set db = Nothing
End Sub

Function Calc残高(DateValue As Date, IDValue As Long) As Long
'作業用現金出納簿の日付、IDでソートした場合のその地点の残高計算

Calc残高 = Nz(DSum("入金 - 出金", "作業用現金出納簿", "日付<#" & DateValue & "#"), 0) _
+ Nz(DSum("入金 - 出金", "作業用現金出納簿", "日付= #" & DateValue & "# and ID<=" &
IDValue), 0) _
End Function

Sub InputData(strTableName As String)
'編集するテーブルデータを作業用テーブルに移します。
DoCmd.SetWarnings False
DoCmd.RunSQL "SELECT * INTO 作業用現金出納簿 FROM " & strTableName & ";"
DoCmd.SetWarnings True
End Sub

Sub OutputData(strTableName As String)
'作業用テーブルデータをに元のテーブル戻します。
DoCmd.SetWarnings False
DoCmd.RunSQL "SELECT * INTO " & strTableName & " FROM 作業用現金出納簿;"
DoCmd.SetWarnings True
End Sub

Function YearTotalKingaku(intYear As Integer)
'その年の差し引き残高を計算します。（前年度からの繰越金を含む）
On Error GoTo EROOR_FUNCTION

Dim strTable As String

strTable = CStr(intYear) & "現金出納簿"

YearTotalKingaku = Nz(DSum("入金", strTable), 0) _
- Nz(DSum("出金", strTable), 0)

END_FUNCTION:
Exit Function

EROOR_FUNCTION:
YearTotalKingaku = 0
GoTo END_FUNCTION

End Function

Sub InputRecord(date日付 As Date, lng科目番号 As Long, str摘要1 As String, _
str摘要2 As String, lng入金 As Long, lng出金 As Long)
'作業用現金出納簿に新しいレコードを追加します。
Set db = CurrentDb
Set rs = db.OpenRecordset("作業用現金出納簿")

rs.AddNew
rs!日付 = date日付
rs!科目番号 = lng科目番号
If str摘要1 <> "" Then rs!摘要1 = str摘要1
If str摘要2 <> "" Then rs!摘要2 = str摘要2
rs!入金 = lng入金
rs!出金 = lng出金
rs.Update

rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Sub

Sub ChangeRecord(date日付 As Date, lng科目番号 As Long, str摘要1 As String, _
str摘要2 As String, lng入金 As Long, lng出金 As Long)
'作業用現金出納簿の編集レコードを変更します。
Set db = CurrentDb
Set rs = db.OpenRecordset("作業用現金出納簿")

Do Until rs.EOF
If rs!ID = WorkID Then
rs.Edit
rs!日付 = date日付
rs!科目番号 = lng科目番号
If str摘要1 <> "" Then rs!摘要1 = str摘要1
If str摘要2 <> "" Then rs!摘要2 = str摘要2
rs!入金 = lng入金
rs!出金 = lng出金
rs.Update
Exit Do
End If
rs.MoveNext
Loop

rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Sub

Sub GetRecord()
'フォーム『START帳簿』のリストからレコードを取得し、変数に格納します。

Set db = CurrentDb
Set rs = db.OpenRecordset("作業用現金出納簿")

Do Until rs.EOF
If rs!ID = WorkID Then
Work日付 = rs!日付
Work科目番号 = rs!科目番号
Work摘要1 = Nz(rs!摘要1)
Work摘要2 = Nz(rs!摘要2)
Work入金 = rs!入金
Work出金 = rs!出金
Exit Do
End If
rs.MoveNext
Loop

rs.Close
db.Close
Set rs = Nothing
Set db = Nothing

End Sub

Sub DeleteRecord()
'フォーム『START帳簿』のリストからレコードを取得し、そのデータを削除します。

Set db = CurrentDb
Set rs = db.OpenRecordset("作業用現金出納簿")

Do Until rs.EOF
If rs!ID = WorkID Then
rs.Delete
Exit Do End If
rs.MoveNext
Loop

rs.Close
db.Close
Set rs = Nothing
Set db = Nothing

End Sub