Option Compare Database
Option Explicit
Dim db As Database
Dim rs As Recordset
Dim MsgFlg As Integer
Dim Kurikosigaku 'As Long

Const strSQL = "SELECT 日付,ID,Dlookup('科目','科目','科目番号=' & 科目番号) AS 科目, " & _
"摘要1, 摘要2, Format(Format(入金,'#,###'),'@@@@@@@@@@') AS 入金額, " & _
"Format(Format(出金,'#,###'),'@@@@@@@@@@') AS 出金額 " & _
"FROM [作業用現金出納簿 クエリー] WHERE Month([日付])="

Private Sub Form_Close()
'作業テーブルからデータを戻します。
If MsgBox("今編集中のデータを保存しますか？", vbYesNo) = vbYes Then
OutputData (WorkTableName)
Else
DoCmd.SetWarnings (False)
DoCmd.RunSQL ("DELETE * FROM 作業用現金出納簿")
DoCmd.SetWarnings (True)
End If

End Sub

Private Sub Form_Load()
[帳簿リスト] = Empty
[帳簿リスト].RowSource = strSQL & SelectMonth
End Sub

Private Sub Form_Open(Cancel As Integer)

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

If rs.RecordCount = 0 Then
If MsgBox("作業用帳簿は未記入です。" & vbCrLf & _
"繰越金額を設定しますか？", vbYesNo) = vbYes Then
KURIKOSISETTEI:
On Error Resume Next
Kurikosigaku = InputBox("繰越金額を設定して下さい。", "繰越額記入", 0)
If Kurikosigaku = "" Then GoTo CancelPoint
If Not IsNumeric(Kurikosigaku) Then MsgBox "記入項目が不適切です。": GoTo KURIKOSISETTEI
If MsgBox("繰越額を " & Format(Kurikosigaku, "#,##0") & _
" 円に設定しますが、よろしいですか？", vbYesNo) = vbNo Then GoTo KURIKOSISETTEI

rs.AddNew
rs![日付] = DateSerial(WorkYear, 1, 0)
rs![科目番号] = 9999
rs![入金] = Kurikosigaku
rs![出金] = 0
rs.Update

Else
GoTo CancelPoint
End If
End If

rs.Close
db.Close

Set rs = Nothing
Set db = Nothing

EndSub:
Exit Sub

CancelPoint:
MsgBox "繰越額設定をキャンセルします。" & vbCrLf & _
"繰越額が設定を拒否されましたので終了します。"
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
DoCmd.Close acForm, "START帳簿"
Exit Sub

End Sub

Private Sub MonthSpin_SpinDown()
If SelectMonth = 1 Then
Exit Sub
Else
SelectMonth = SelectMonth - 1
End If
Form_Load
End Sub

Private Sub MonthSpin_SpinUp()

If SelectMonth = 12 Then
Exit Sub
Else
SelectMonth = SelectMonth + 1
End If
Form_Load
End Sub

Private Sub SelectMonth_AfterUpdate()
Form_Load
End Sub

Private Sub 繰越額変更_Click()
Dim Kingaku

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

Do Until rs.EOF
If rs![科目番号] = 9999 Then
Kingaku = rs![入金]
Exit Do
End If
Loop

KURIKOSISETTEI:
Kurikosigaku = InputBox("新しい繰越金額を記入して下さい。" & vbCrLf & vbCrLf & _
"下の数字が今現在の繰越額です。", "繰越金額変更", Kingaku)
If Kurikosigaku = "" Then GoTo CancelPoint
If Not IsNumeric(Kurikosigaku) Then MsgBox "記入項目が不適切です。": GoTo KURIKOSISETTEI
If MsgBox("繰越額を " & Format(Kurikosigaku, "#,##0") & _
" 円に設定し直しますが、よろしいですか？", vbYesNo) = vbNo Then GoTo KURIKOSISETTEI

rs.MoveFirst
Do Until rs.EOF
If rs![科目番号] = 9999 Then
rs.Edit
rs![入金] = Kurikosigaku

rs.Update
Exit Do
End If
Loop

rs.Close
db.Close

Set rs = Nothing
Set db = Nothing

繰越額表示.Requery

EndSub:
Exit Sub
CancelPoint:
MsgBox "繰越額再設定をキャンセルします。"
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing

End Sub

Private Sub 残高照会_Click()
If IsNull(帳簿リスト) Then MsgBox "帳簿リストの残高照会する項目を選択して下さい。": Exit Sub

Dim i As Integer
For i = 1 To 帳簿リスト.ListCount
If 帳簿リスト.Selected(i) = True Then
MsgBox "日付： " & 帳簿リスト.Column(0, i) & vbCrLf & _
"科目： " & 帳簿リスト.Column(2, i) & vbCrLf & _
"摘要： " & 帳簿リスト.Column(3, i) & " " & 帳簿リスト.Column(4, i) & vbCrLf & _
"入金額： " & LTrim(帳簿リスト.Column(5, i)) & vbCrLf & _
"出金額： " & LTrim(帳簿リスト.Column(6, i)) & vbCrLf & vbCrLf & _
"この時点での差引残高は " & Format(DLookup("差引残高", _
"作業用現金出納簿 クエリー", "ID=" & 帳簿リスト), "#,##0 円")
Exit For
End If
Next

End Sub
Private Sub 終了_Click()
DoCmd.Close acForm, "START帳簿"
End Sub

Private Sub 帳簿リスト_DblClick(Cancel As Integer)
変更_Click
End Sub
Private Sub 帳簿印刷_Click()
DoCmd.OpenReport "商工会提出用帳簿", acViewPreview
End Sub

Private Sub 帳簿確認用_Click()
DoCmd.OpenReport "帳簿確認", acViewPreview
End Sub

Private Sub 追加_Click()
DoCmd.OpenForm "単票"
Forms!単票!追加.Visible = True
Forms!単票!終了.Visible = True

End Sub

Private Sub 伝票削除_Click()
If IsNull(帳簿リスト) Then MsgBox "帳簿リストの削除する項目を選択して下さい。": Exit Sub

WorkID = 帳簿リスト

If MsgBox("削除されたデータは、元に戻りませんがよろしいですか？", _
vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub

DeleteRecord

帳簿リスト.Requery
End Sub

Private Sub 変更_Click()
If IsNull(帳簿リスト) Then MsgBox "帳簿リストの変更する項目を選択して下さい。": Exit Sub

WorkID = 帳簿リスト

DoCmd.OpenForm "単票"
Forms!単票!変更.Visible = True
Forms!単票!終了.Visible = True

GetRecord

Forms!単票!日付 = Work日付
Forms!単票!科目番号 = Work科目番号
Forms!単票!摘要1 = Work摘要1
Forms!単票!摘要2 = Work摘要2
If Work出金 = 0 Then
Forms!単票!入金ラベル.Visible = True
Forms!単票!入金額.Visible = True
Forms!単票!入金額 = Work入金
Else
Forms!単票!出金ラベル.Visible = True
Forms!単票!出金額.Visible = True
Forms!単票!出金額 = Work出金
End If

End Sub