Access VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

2958 / 9994

←次へ　｜　前へ→


	【10300】Re:和暦チェック

VBWASURETA - 08/3/13(木) 10:40 -


	引用なし

	パスワード

▼ぎんばしゃさん：

おはようございます。
もう解決されたのかわかりませんが、サンプルを置いておきます。

Type userYear
　　intYear As Integer
　　ChakDate As Date
End Type

Dim testyear() As userYear

'制限データセット関数
Function setYaerdata()
　　ReDim testyear(3) As userYear
　　
　　'配列はtestyear(暦値,制限値)の二次元配列で管理
　　'素数２番目が 0 は制限年
　　testyear(0).intYear = 15　　　　　　'15年まで
　　'素数２番目が 1 は制限年月日
　　testyear(0).ChakDate = #1/1/1980#　 '1980/01/01まで
　　
　　testyear(1).intYear = 8　　　　　　 '8年まで
　　testyear(1).ChakDate = #7/1/1990#　 '1990/07/01
　　
　　testyear(2).intYear = 12　　　　　　'12年まで
　　testyear(2).ChakDate = #1/7/1998#　 '1998/01/07
　　
　　'現在
　　testyear(3).intYear = Year(Date) - Year(testyear(2).ChakDate)
　　testyear(3).ChakDate = Date　　　　 '現在年月日
End Function

'年チェック関数 YearCalc(暦値,年,月,日)
Function YearCalc(intlist As Integer, _
　　　　　　　　　　intYear As Integer, _
　　　　　　　　　　intmonth As Integer, _
　　　　　　　　　　intday As Integer) As Boolean
　　　　　　　　　　
　　On Error GoTo YearCalc_ERR
　　
　　Dim setdate As Date
　　
　　'制限年内であればTrueで返す
　　If (testyear(intlist).intYear > intYear) Then
　　　　YearCalc = True
　　Else
　　　　'入力された値（比較する日）を日付型に変換
　　　　setdate = DateSerial(Year(testyear(intlist).ChakDate), intmonth, intday)
　　　　　　　　
　　　　'制限年月日内であればTrueで返す
　　　　If (testyear(intlist).ChakDate >= setdate) Then
　　　　　　YearCalc = True
　　　　End If
　　End If
　　
　　Exit Function
YearCalc_ERR:
　　'制限年データがセットされてなければFalseで抜ける
　　YearCalc = False
　　Debug.Print Err.Number & ":" & Err.Description
　　
End Function

Sub test()
　　Dim textdate As Date
　　
　　'制限年データセット
　　setYaerdata
　　
　　'日付比較 OKならばTrue、範囲外はfalseを返す。
　　'例：暦1 8年7月1日
　　MsgBox YearCalc(1, 8, 7, 1)

End Sub

778 hits

▼

【10291】和暦チェック ぎんばしゃ 08/3/4(火) 13:28