accessvba.xlsm

Private const fWater as string = "frm水族館"

Public const bench as integer = 1
Public const storage as integer = 200
Public const minimum as integer = 0
・・・・

Private Sub cmdWater_click()
	Const subf  as string = "cmdWater_click"
	Dim tSql      as string
	Dim aquarium  as dao.recordset
	Dim money     as double
	Dim deposit   as double
	Dim paid      as double
	Dim zankin    as doubel
	Dim number    as long
	Dim recent    as Integer
	Dim spot      as String
	Dim future    as Long
	Dim date      as Long
 
	 On Error Go To Err_Proc
	 DoCmd.Hourglass True

	future = CLng(Format(kansu1(Me.TDate.Value),"YYYYMMDD"))

	date = Int(CLng(Format(Me.TDate.Value),"YYYYMMDD")) / 100)

	tSql = ""
	tSql = "select 水族館ID,都道府県ID from 水族館マスタ"
	tSql = tSql & "where 管轄 = 1"
	tSql = tSql & "and not (水族館ID =" & bench & "and 都道府県ID = " & storage & ")"
	tSql = tSql & "and (開館日 is null or 開館日 > " & date & ")"
	tSql = tSql & "order by 順番,水族館ID,都道府県ID"
	Set aquarium = dbinfo.OpenRecordset(tSql,dbOpenDynaset)
	If aquarium.EOF then GoTo Exit_proc

	With aquarium
	Do until.EOF
		If Not kansu2(.Fields(0).Value, .Fields(1).Value, money) Then GoTo Err_Proc

		If Not kansu3(.Fields(0).Value, .Fields(1).Value, deposit) Then GoTo Err_Proc

		If Not kansu4(.Fields(0).Value, .Fields(1).Value, paid) Then GoTo Err_Proc

		zankin = money + deposit - paid
	
		spot = ""
		spot = "予定 = " & future
		spot = spot & "and 水族館ID = " & .Fields(0).Value
		spot = spot & "and 都道府県ID = " & .Fields(1).Value
		recent = DCount("番号","入場者数",spot)

    tSql = ""
    If recent = minimum Then
    		number = IIf(IsNull(Dmax("番号","入場者数")),1, Dmax("番号","入場者数") + 1)
			tSql = "insert into 入場者数 values ("
			tSql = tSql & number & "," & future & ","
			tSql = tSql & .Fields(0).Value & "," & Fields(1).Value & ","
			tSql = tSql & minimum & "," & minimum &"," & minimum & "," & zankin & ","
			tSql = tSql & Format(Now,"YYYYMMDD") & "," & Format(Now,"HHMMSS") & ")"
	Else
    		number = DLookUp("番号","入場者数")
			tSql = "update 入場者数 set"
			tSql = tSql & "日別入場者数 = " & zankin & ","
			tSql = tSql & "集計日 = " & Format(Now,"YYYYMMDD") & ","
			tSql = tSql & "時刻 = " & Format(Now,"HHMMSS")
			tSql = tSql & "where 番号 = " & number
	End If
	dbinfo.Execute tSql
	.MoveNext
   Loop
   End With
   DoCmd.Hourglass False
    Call ShowMsg(fWater,subf,"完了しました")
   Exit Sub

Exit_proc:
   DoCmd.Hourglass False
   If Not aquarium is nothing then Set aquarium = Nothing
   Call Showmsg(fWater,subf,"未入力の項目があります")
   Exit Sub

Err_proc:
   DoCmd.Hourglass False
   If Not aquarium is nothing then Set aquarium = Nothing
   Call Showmsg(fWater,subf,Err.Description)

End Sub