SAK 図書館
SAK 図書館
VB テクニック編20 - 数値チェック、文字チェック、日付チェック、時間チェック
■SAK 関数利用規程
・テクニック編で紹介する関数は、私こと Y.SAK の開発関数である。
・著作権明示部分の改編は認めない。
・個人、企業がこれらの関数を使用したり、一部を使用して新たなシステムや
プログラムを開発することは自由です。
・但し、これらの関数を一部でも使用しているソフトウェアをシェアウェア、
その他有償プロダクトとして配布・販売するには、私の許可が必要です。
(無償のフリーソフトウェアなら、自由に配布しても良い。)
・これらの関数を使用して発生した、いかなる形での損害も私こと Y.SAK は
賠償しません。
■数値入力チェック
・数値入力のチェックは、次のようにする。
(数字チェック、全角判別、入力項目チェック、桁数チェック、数字入力、入力制限)
全角で入力されても半角に自動変換される。
最大 6 桁、ゼロサプレス、カンマ編集, 省略値 0、ゼロ OK、マイナス不可。
if ChkVal(text1, "###,##0", "0", OK_ZERO, NO_MINS) = false then
msgbox "数値でないか、桁オーバ、マイナスデータ"
end if
・最大 6 桁、ゼロ埋め, 省略値 000001、ゼロ不可、マイナス不可。
(必須項目チェック)
if ChkVal(text1, "000000", "000001", NO_ZERO, NO_MINS) = false then
msgbox "数値でないか、桁オーバ、ゼロ、マイナスデータ"
end if
■文字入力チェック
・入力文字チェックは、次のようにする。
(全角チェック、半角チェック、英数字チェック、全角判別)
全角で入力されても半角指定の場合は、自動的に半角変換される。
最大 6 桁、省略値 ""、半角英数字のみ、未入力 OK。
ここで言う 6 桁とは、半角を 1 桁、全角を 2 桁とします。
(バイト数チェックによる、バイト長による制限)
(バイトチェック、byte 数チェック、byte チェック、バイト数制限)
(バイト制限、byte 数制限、byte 制限、文字数チェック、文字チェック)
(文字数制限、文字制限、文字列チェック、文字列制限、バイト計算)
(byte 計算、文字数計算、半角区別)
if ChkStr(text1, 6, NO_DEF, HAN_UP, STYPE_HAN_A, OK_NULL) = false then
msgbox "桁オーバ、半角英数字でない"
end if
・最大 6 桁、省略値 "abc"、半角のみ、未入力不可。
(必須項目チェック)
if ChkStr(text1, 6, "abc", HAN_LOW, STYPE_HAN, NO_NULL) = false then
msgbox "桁オーバ、半角でない、未入力"
end if
・最大 6 桁、省略値 ""、未入力 OK。
if ChkStr(text1, 6, NO_DEF, HAN_NO, STYPE_NO, OK_NULL) = false then
msgbox "桁オーバ"
end if
■フォーマット入力チェック
・フォーマット入力のチェックは、次のようにする。
全角で入力されても半角指定の場合は、自動的に半角変換される。
000001-001 形式入力、省略値 ""、半角のみ、ゼロ不可。
00001001、1-1、1.1、1/1、1 1 などの入力が可能。
if ChkFormat(text1, "000000-000", NO_DEF, HAN_HAN, NO_ZERO, NO_ZERO, NO_ZERO, NO_ZERO) = false then
msgbox "桁オーバ、半角でない、ゼロ"
end if
・@@@@@@-001 形式入力、省略値 ""、半角大文字のみ、ゼロ不可。
abcdef001、abc-1、abc.1、abc/1、abc 1 などの入力が可能。
if ChkFormat(text1, "@@@@@@@-000", NO_DEF, HAN_UP, NO_ZERO, NO_ZERO, NO_ZERO, NO_ZERO) = false then
msgbox "桁オーバ、半角でない、ゼロ"
end if
■日付入力チェック
・日付入力のチェックは、次のようにする。
全角で入力されても半角に自動変換される。
29 〜 31 日の入力で、月末日オーバは自動調整される。
20011001、2001.10.1、2001/10/1、2001-10-1、2001 10 1 1/1/1 などの
入力が可能。
尚、日付関係のチェック関数には、
VB テクニック編5 - カレンダー計算、通算日、月末日、うるう年、曜日
の CalcDate 関数が必要である。
if ChkDate(text1, NO_DEF, NO_NULL, OK_SHORT) = false then
msgbox "日付でない、未入力"
end if
■時間入力チェック
・時間入力のチェックは、次のようにする。
全角で入力されても半角に自動変換される。
190100、19:1:0、19/1/0、19-1-0、19 1 0 などの入力が可能。
if ChkTime(text1, NO_DEF, NO_NULL) = false then
msgbox "時間でない、未入力"
end if
■データ入力チェック関数
'** 半角変換定数宣言
Public Const HAN_HAN = 0
Public Const HAN_LOW = 1
Public Const HAN_UP = 2
Public Const HAN_NO = 9
'** 文字タイプ定数宣言
Public Const STYPE_NO = 0
Public Const STYPE_HAN_A = 1
Public Const STYPE_HAN = 2
Public Const STYPE_ZEN = 3
'** チェック定数宣言
Public Const NO_DEF = ""
Public Const OK_ZERO = False
Public Const NO_ZERO = True
Public Const OK_MINS = False
Public Const NO_MINS = True
Public Const OK_NULL = False
Public Const NO_NULL = True
Public Const OK_SHORT = True
Public Const NO_SHORT = False
Public Const LOW_CASE = True
Public Const NO_CASE = False
'=======================================================================
' 数値チェック(テキストコントロール)
'=======================================================================
'【引数】
' ctl = 【入出力】テキストコントロール
' ft = フォーマット
' "000000000"
' "########0"
' "########0.00"
' "###,###,##0"
' "###,###,##0.00"
' def = デフォルト
' NO_DEF = デフォルトなし
' zr = ゼロチェック
' NO_ZERO = ゼロは許さない
' OK_ZERO = チェックしない
' ms = マイナスチェック
' NO_MINS = マイナスは許さない
' OK_MINS = チェックしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = 数値でない
'【処理】
' ・テキストコントロールの内容が数値なら、ft に従ってフォーマットする。
' ・ft が "" のときはフォーマットしない。
' ・入力が省略されているときは、def をセットします。
'【著作権】
' ChkVal() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkVal(ctl As Variant, ft As String, def As Variant, zr As Boolean, ms As Boolean) As Boolean
Dim dt As Double
Dim s As String
'** デフォルトセット
If def <> "" And Trim(ctl.Text) = "" Then ctl.Text = def
'** 数値チェック
On Local Error Resume Next
Err = 0
dt = ctl.Text
If Err <> 0 Then
s = ctl.Text
Else
s = LTrim(Str(dt))
End If
On Local Error GoTo 0
ChkVal = ChkVals(s, ft, zr, ms)
ctl.Text = s
End Function
'=======================================================================
' 文字列チェック(テキストコントロール)
'=======================================================================
'【引数】
' ctl = 【入出力】テキストコントロール
' ft = フォーマット(フォーマット文字列、または、最大バイト数。)
' "@@@@@@@@@"
' 最大バイト数
' def = デフォルト
' NO_DEF = デフォルトなし
' han = 半角変換モード
' HAN_HAN = 半角にする
' HAN_LOW = 小文字半角にする
' HAN_UP = 大文字半角にする
' HAN_NO = 半角変換しない
' stype = 文字タイプ
' STYPE_NO = チッェクしない
' STYPE_HAN_A = 半角英数字でなければエラー
' STYPE_HAN = 半角でなければエラー
' STYPE_ZEN = 全角でなければエラー
' nu = "" チェック
' NO_NULL = "" は許さない
' OK_NULL = チェックしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・テキストコントロールの内容を、ft に従ってフォーマットする。
' ・ft が "" のときはフォーマットしない。
' ・入力が省略されているときは、def をセットします。
'【著作権】
' ChkStr() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkStr(ctl As Variant, ft As Variant, def As Variant, han As Integer, stype As Integer, nu As Boolean) As Boolean
Dim s As String
'** デフォルトセット
If def <> "" And Trim(ctl.Text) = "" Then ctl.Text = def
'** 文字列チェック
s = ctl.Text
ChkStr = ChkStrs(s, ft, han, stype, nu)
ctl.Text = s
End Function
'=======================================================================
' フォーマットチェック(テキストコントロール)
'=======================================================================
'【引数】
' ctl = 【入出力】テキストコントロール
' ft = フォーマット(4 項目まで。1 項目の定義に "0" と "@" が混在し
' てはならない。"0" = 数字、"@" = 文字。)
' "0000-000000-000"
' "@@@@@@@@@-00"
' "@@@@@@@@@-@@-@@-@@"
' def = デフォルト
' NO_DEF = デフォルトなし
' han = 半角変換モード
' HAN_HAN = 半角にする
' HAN_LOW = 小文字半角にする
' HAN_UP = 大文字半角にする
' z1 = ゼロチェック 1 項目
' NO_ZERO = ゼロは許さない
' OK_ZERO = チェックしない
' z2 = ゼロチェック 2 項目
' z3 = ゼロチェック 3 項目
' z4 = ゼロチェック 4 項目
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・テキストコントロールの内容を、ft に従ってフォーマットする。
' 但し、最大 4 項目のフォーマットしか出来ない。
' ・入力が省略されているときは、def をセットします。
'【著作権】
' ChkFormat() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkFormat(ctl As Variant, ft As String, def As Variant, han As Integer, z1 As Boolean, z2 As Boolean, z3 As Boolean, z4 As Boolean) As Boolean
Dim s As String
'** デフォルトセット
If def <> "" And Trim(ctl.Text) = "" Then ctl.Text = def
'** フォーマットチェック
s = ctl.Text
ChkFormat = ChkFormats(s, ft, han, z1, z2, z3, z4)
ctl.Text = s
End Function
'=======================================================================
' 日付チェック
'=======================================================================
'【引数】
' ctl = 【入出力】テキストコントロール
' def = デフォルト
' NO_DEF = デフォルトなし
' nu = "" チェック
' NO_NULL = "" は許さない
' OK_NULL = チェックしない
' short = 西暦年上 2 桁省略入力
' OK_SHORT = 2 桁 → 4 桁変換する
' NO_SHORT = なにもしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・日付フォーマットをする。
' ・入力が省略されているときは、def をセットします。
' ・short が TRUE のとき、99 年までの 2 桁入力がされると、西暦 4 桁年に
' 変換します。
'【著作権】
' ChkDate() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkDate(ctl As Variant, def As Variant, nu As Boolean, short As Boolean) As Boolean
Dim s As String
Dim a As String
Dim rcd As Boolean
Dim days As Long
Dim yb As Integer
Dim ybnm As String
Dim ybjp As String
'** デフォルトセット
If def <> "" And Trim(ctl.Text) = "" Then ctl.Text = def
'** フォーマットチェック
s = ctl.Text
rcd = ChkFormats(s, "0000.00.00", HAN_HAN, True, True, True, True)
ctl.Text = s
If nu = False And s = "" Then
ChkDate = True
Exit Function
End If
If rcd = False Then
ChkDate = rcd
Exit Function
End If
'** エラーセット
ChkDate = False
'** 年 2 桁処理
If short Then
a = Left(s, 4)
If a < "0100" Then
If a < "0050" Then
Mid(s, 1, 2) = "20"
Else
Mid(s, 1, 2) = "19"
End If
End If
End If
'** 日付チェック
If Left(s, 4) < "0001" Then Exit Function
a = Mid(s, 6, 2)
If a < "01" Or a > "12" Then Exit Function
a = Right(s, 2)
If a < "01" Or a > "31" Then Exit Function
'** 月末日調整
days = CalcDate(s, yb, ybnm, ybjp)
ctl.Text = s
'** 正常セット
ChkDate = True
End Function
'=======================================================================
' 年月チェック
'=======================================================================
'【引数】
' ctl = 【入出力】テキストコントロール
' def = デフォルト
' NO_DEF = デフォルトなし
' nu = "" チェック
' NO_NULL = "" は許さない
' OK_NULL = チェックしない
' short = 西暦年上 2 桁省略入力
' OK_SHORT = 2 桁 → 4 桁変換する
' NO_SHORT = なにもしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・年月フォーマットをする。
' ・入力が省略されているときは、def をセットします。
' ・short が TRUE のとき、99 年までの 2 桁入力がされると、西暦 4 桁年に
' 変換します。
'【著作権】
' ChkYYMM() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkYYMM(ctl As Variant, def As Variant, nu As Boolean, short As Boolean) As Boolean
Dim s As String
Dim a As String
Dim rcd As Boolean
'** デフォルトセット
If def <> "" And Trim(ctl.Text) = "" Then ctl.Text = def
'** フォーマットチェック
s = ctl.Text
rcd = ChkFormats(s, "0000.00", HAN_HAN, True, True, True, True)
ctl.Text = s
If nu = False And s = "" Then
ChkYYMM = True
Exit Function
End If
If rcd = False Then
ChkYYMM = rcd
Exit Function
End If
'** エラーセット
ChkYYMM = False
'** 年 2 桁処理
If short Then
a = Left(s, 4)
If a < "0100" Then
If a < "0050" Then
Mid(s, 1, 2) = "20"
Else
Mid(s, 1, 2) = "19"
End If
End If
End If
'** 日付チェック
If Left(s, 4) < "0001" Then Exit Function
a = Right(s, 2)
If a < "01" Or a > "12" Then Exit Function
ctl.Text = s
'** 正常セット
ChkYYMM = True
End Function
'=======================================================================
' 月日チェック
'=======================================================================
'【引数】
' ctl = 【入出力】テキストコントロール
' def = デフォルト
' NO_DEF = デフォルトなし
' nu = "" チェック
' NO_NULL = "" は許さない
' OK_NULL = チェックしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・月日フォーマットをする。
' ・入力が省略されているときは、def をセットします。
'【著作権】
' ChkMMDD() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkMMDD(ctl As Variant, def As Variant, nu As Boolean) As Boolean
Dim s As String
Dim a As String
Dim rcd As Boolean
Dim days As Long
Dim yb As Integer
Dim ybnm As String
Dim ybjp As String
'** デフォルトセット
If def <> "" And Trim(ctl.Text) = "" Then ctl.Text = def
'** フォーマットチェック
s = ctl.Text
rcd = ChkFormats(s, "00.00", HAN_HAN, True, True, True, True)
ctl.Text = s
If nu = False And s = "" Then
ChkMMDD = True
Exit Function
End If
If rcd = False Then
ChkMMDD = rcd
Exit Function
End If
'** エラーセット
ChkMMDD = False
'** 日付チェック
a = Left(s, 2)
If a < "01" Or a > "12" Then Exit Function
a = Right(s, 2)
If a < "01" Or a > "31" Then Exit Function
'** 月末日調整
s = "0001." + s
days = CalcDate(s, yb, ybnm, ybjp)
ctl.Text = Right(s, 5)
'** 正常セット
ChkMMDD = True
End Function
'=======================================================================
' 年チェック
'=======================================================================
'【引数】
' ctl = 【入出力】テキストコントロール
' def = デフォルト
' NO_DEF = デフォルトなし
' nu = "" チェック
' NO_NULL = "" は許さない
' OK_NULL = チェックしない
' short = 西暦年上 2 桁省略入力
' OK_SHORT = 2 桁 → 4 桁変換する
' NO_SHORT = なにもしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・年フォーマットをする。
' ・入力が省略されているときは、def をセットします。
' ・short が TRUE のとき、99 年までの 2 桁入力がされると、西暦 4 桁年に
' 変換します。
'【著作権】
' ChkYY() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkYY(ctl As Variant, def As Variant, nu As Boolean, short As Boolean) As Boolean
Dim s As String
Dim a As String
Dim rcd As Boolean
'** デフォルトセット
If def <> "" And Trim(ctl.Text) = "" Then ctl.Text = def
'** フォーマットチェック
s = Trim(ctl.Text)
If nu = False And s = "" Then
ChkYY = True
Exit Function
End If
rcd = ChkVals(s, "0000", True, True)
ctl.Text = s
If rcd = False Then
ChkYY = rcd
Exit Function
End If
'** エラーセット
ChkYY = False
'** 年 2 桁処理
If short Then
If s < "0100" Then
If s < "0050" Then
Mid(s, 1, 2) = "20"
Else
Mid(s, 1, 2) = "19"
End If
End If
End If
'** 日付チェック
If s < "0001" Then Exit Function
ctl.Text = s
'** 正常セット
ChkYY = True
End Function
'=======================================================================
' 月チェック
'=======================================================================
'【引数】
' ctl = 【入出力】テキストコントロール
' def = デフォルト
' NO_DEF = デフォルトなし
' nu = "" チェック
' NO_NULL = "" は許さない
' OK_NULL = チェックしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・月フォーマットをする。
' ・入力が省略されているときは、def をセットします。
'【著作権】
' ChkMM() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkMM(ctl As Variant, def As Variant, nu As Boolean) As Boolean
Dim s As String
Dim a As String
Dim rcd As Boolean
'** デフォルトセット
If def <> "" And Trim(ctl.Text) = "" Then ctl.Text = def
'** フォーマットチェック
s = Trim(ctl.Text)
If nu = False And s = "" Then
ChkMM = True
Exit Function
End If
rcd = ChkVals(s, "00", True, True)
ctl.Text = s
If rcd = False Then
ChkMM = rcd
Exit Function
End If
'** エラーセット
ChkMM = False
'** 日付チェック
If s < "01" Or s > "12" Then Exit Function
'** 正常セット
ChkMM = True
End Function
'=======================================================================
' 日チェック
'=======================================================================
'【引数】
' ctl = 【入出力】テキストコントロール
' def = デフォルト
' NO_DEF = デフォルトなし
' nu = "" チェック
' NO_NULL = "" は許さない
' OK_NULL = チェックしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・日フォーマットをする。
' ・入力が省略されているときは、def をセットします。
'【著作権】
' ChkDD() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkDD(ctl As Variant, def As Variant, nu As Boolean) As Boolean
Dim s As String
Dim a As String
Dim rcd As Boolean
'** デフォルトセット
If def <> "" And Trim(ctl.Text) = "" Then ctl.Text = def
'** フォーマットチェック
s = Trim(ctl.Text)
If nu = False And s = "" Then
ChkDD = True
Exit Function
End If
rcd = ChkVals(s, "00", True, True)
ctl.Text = s
If rcd = False Then
ChkDD = rcd
Exit Function
End If
'** エラーセット
ChkDD = False
'** 日付チェック
If s < "01" Or s > "31" Then Exit Function
'** 正常セット
ChkDD = True
End Function
'=======================================================================
' 時間チェック
'=======================================================================
'【引数】
' ctl = 【入出力】テキストコントロール
' def = デフォルト
' NO_DEF = デフォルトなし
' nu = "" チェック
' NO_NULL = "" は許さない
' OK_NULL = チェックしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・時間フォーマットをする。
' ・入力が省略されているときは、def をセットします。
'【著作権】
' ChkTime() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkTime(ctl As Variant, def As Variant, nu As Boolean) As Boolean
Dim s As String
Dim a As String
Dim rcd As Boolean
'** デフォルトセット
If def <> "" And Trim(ctl.Text) = "" Then ctl.Text = def
'** フォーマットチェック
s = Trim(ctl.Text)
If nu = False And s = "" Then
ChkTime = True
Exit Function
End If
rcd = ChkFormats(s, "00:00:00", HAN_HAN, False, False, False, False)
ctl.Text = s
If rcd = False Then
ChkTime = rcd
Exit Function
End If
'** エラーセット
ChkTime = False
'** 時間チェック
a = Left(s, 2)
If a < "00" Or a > "23" Then Exit Function
a = Mid(s, 4, 2)
If a < "00" Or a > "59" Then Exit Function
a = Right(s, 2)
If a < "00" Or a > "59" Then Exit Function
'** 正常セット
ChkTime = True
End Function
'=======================================================================
' 時分チェック
'=======================================================================
'【引数】
' ctl = 【入出力】テキストコントロール
' def = デフォルト
' NO_DEF = デフォルトなし
' nu = "" チェック
' NO_NULL = "" は許さない
' OK_NULL = チェックしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・時分フォーマットをする。
' ・入力が省略されているときは、def をセットします。
'【著作権】
' ChkHHMN() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkHHMN(ctl As Variant, def As Variant, nu As Boolean) As Boolean
Dim s As String
Dim a As String
Dim rcd As Boolean
'** デフォルトセット
If def <> "" And Trim(ctl.Text) = "" Then ctl.Text = def
'** フォーマットチェック
s = Trim(ctl.Text)
If nu = False And s = "" Then
ChkHHMN = True
Exit Function
End If
rcd = ChkFormats(s, "00:00", HAN_HAN, False, False, False, False)
ctl.Text = s
If rcd = False Then
ChkHHMN = rcd
Exit Function
End If
'** エラーセット
ChkHHMN = False
'** 時分チェック
a = Left(s, 2)
If a < "00" Or a > "23" Then Exit Function
a = Right(s, 2)
If a < "00" Or a > "59" Then Exit Function
'** 正常セット
ChkHHMN = True
End Function
'=======================================================================
' 分秒チェック
'=======================================================================
'【引数】
' ctl = 【入出力】テキストコントロール
' def = デフォルト
' NO_DEF = デフォルトなし
' nu = "" チェック
' NO_NULL = "" は許さない
' OK_NULL = チェックしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・分秒フォーマットをする。
' ・入力が省略されているときは、def をセットします。
'【著作権】
' ChkMNSC() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkMNSC(ctl As Variant, def As Variant, nu As Boolean) As Boolean
Dim s As String
Dim a As String
Dim rcd As Boolean
'** デフォルトセット
If def <> "" And Trim(ctl.Text) = "" Then ctl.Text = def
'** フォーマットチェック
s = Trim(ctl.Text)
If nu = False And s = "" Then
ChkMNSC = True
Exit Function
End If
rcd = ChkFormats(s, "00.00", HAN_HAN, False, False, False, False)
ctl.Text = s
If rcd = False Then
ChkMNSC = rcd
Exit Function
End If
'** エラーセット
ChkMNSC = False
'** 分秒チェック
a = Left(s, 2)
If a < "00" Or a > "59" Then Exit Function
a = Right(s, 2)
If a < "00" Or a > "59" Then Exit Function
'** 正常セット
ChkMNSC = True
End Function
'=======================================================================
' 時チェック
'=======================================================================
'【引数】
' ctl = 【入出力】テキストコントロール
' def = デフォルト
' NO_DEF = デフォルトなし
' nu = "" チェック
' NO_NULL = "" は許さない
' OK_NULL = チェックしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・時フォーマットをする。
' ・入力が省略されているときは、def をセットします。
'【著作権】
' ChkHH() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkHH(ctl As Variant, def As Variant, nu As Boolean) As Boolean
Dim s As String
Dim a As String
Dim rcd As Boolean
'** デフォルトセット
If def <> "" And Trim(ctl.Text) = "" Then ctl.Text = def
'** フォーマットチェック
s = Trim(ctl.Text)
If nu = False And s = "" Then
ChkHH = True
Exit Function
End If
rcd = ChkVals(s, "00", False, True)
ctl.Text = s
If rcd = False Then
ChkHH = rcd
Exit Function
End If
'** エラーセット
ChkHH = False
'** 時チェック
If s < "00" Or s > "23" Then Exit Function
'** 正常セット
ChkHH = True
End Function
'=======================================================================
' 分チェック
'=======================================================================
'【引数】
' ctl = 【入出力】テキストコントロール
' def = デフォルト
' NO_DEF = デフォルトなし
' nu = "" チェック
' NO_NULL = "" は許さない
' OK_NULL = チェックしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・分フォーマットをする。
' ・入力が省略されているときは、def をセットします。
'【著作権】
' ChkMN() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkMN(ctl As Variant, def As Variant, nu As Boolean) As Boolean
Dim s As String
Dim a As String
Dim rcd As Boolean
'** デフォルトセット
If def <> "" And Trim(ctl.Text) = "" Then ctl.Text = def
'** フォーマットチェック
s = Trim(ctl.Text)
If nu = False And s = "" Then
ChkMN = True
Exit Function
End If
rcd = ChkVals(s, "00", False, True)
ctl.Text = s
If rcd = False Then
ChkMN = rcd
Exit Function
End If
'** エラーセット
ChkMN = False
'** 分チェック
If s < "00" Or s > "59" Then Exit Function
'** 正常セット
ChkMN = True
End Function
'=======================================================================
' 秒チェック
'=======================================================================
'【引数】
' ctl = 【入出力】テキストコントロール
' def = デフォルト
' NO_DEF = デフォルトなし
' nu = "" チェック
' NO_NULL = "" は許さない
' OK_NULL = チェックしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・秒フォーマットをする。
' ・入力が省略されているときは、def をセットします。
'【著作権】
' ChkSC() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkSC(ctl As Variant, def As Variant, nu As Boolean) As Boolean
Dim s As String
Dim a As String
Dim rcd As Boolean
'** デフォルトセット
If def <> "" And Trim(ctl.Text) = "" Then ctl.Text = def
'** フォーマットチェック
s = Trim(ctl.Text)
If nu = False And s = "" Then
ChkSC = True
Exit Function
End If
rcd = ChkVals(s, "00", False, True)
ctl.Text = s
If rcd = False Then
ChkSC = rcd
Exit Function
End If
'** エラーセット
ChkSC = False
'** 秒チェック
If s < "00" Or s > "59" Then Exit Function
'** 正常セット
ChkSC = True
End Function
'=======================================================================
' 半角変換
'=======================================================================
'【引数】
' dt = 文字列
' mode = 変換モード
' HAN_HAN = 半角にする
' HAN_LOW = 小文字半角にする
' HAN_UP = 大文字半角にする
'【戻り値】
' string = 半角文字列
'【処理】
' ・文字列を mode に従って半角にして返します。
' ・英数字記号以外の半角変換不能全角文字はそのまま返します。
'【著作権】
' Hankaku() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function Hankaku(dt As Variant, mode As Integer) As String
Dim i As Integer
Dim s As String
Dim a As String
Dim z As String
'** データ整形
s = Trim(dt)
'** 半角変換
For i = 1 To Len(s)
a = Mid(s, i, 1)
If a >= " " And a <= "~" Or a >= "｡" And a <= "ﾟ" Then
z = z + a
Else
Select Case a
Case " "
z = z + " "
Case "，"
z = z + ","
Case "："
z = z + ":"
Case "．"
z = z + "."
Case "／"
z = z + "/"
Case "−"
z = z + "-"
Case "ー"
z = z + "-"
Case Else
If a >= "０" And a <= "９" Or a >= "Ａ" And a <= "Ｚ" Then
z = z + Chr(Asc(a) + &H7DE1)
Else
If a >= "ａ" And a <= "ｚ" Then
z = z + Chr(Asc(a) + &H7DE0)
Else
z = z + a
End If
End If
End Select
End If
Next
'** 大文字、小文字変換
Select Case mode
Case HAN_LOW
z = LCase(z)
Case HAN_UP
z = UCase(z)
End Select
'** 半角文字列セット
Hankaku = z
End Function
'=======================================================================
' 数値変換
'=======================================================================
'【引数】
' s = コントロールか文字列
'【戻り値】
' double = 数値
'【処理】
' ・カンマ付き数値文字も含めて全て数値に変換して返します。
'【著作権】
' CnvVal() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function CnvVal(s As Variant) As Double
Dim dt As Double
'** 数値変換
On Local Error Resume Next
if isnull(s) then
dt = 0
else
dt = 0
dt = s
end if
If Err <> 0 Then
CnvVal = 0
CnvVal = Val(s)
Else
CnvVal = dt
End If
On Local Error GoTo 0
End Function
'=======================================================================
' 数値文字列変換
'=======================================================================
'【引数】
' s = コントロールか文字列
'【戻り値】
' string = 数値文字列
'【処理】
' ・カンマ付き数値文字も含めて全て有効な数値文字列に変換して返します。
'【著作権】
' CnvStrVal() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function CnvStrVal(s As Variant) As String
'** 数値文字列変換
CnvStrVal = LTrim(Str(CnvVal(s)))
End Function
'=======================================================================
' 文字変換
'=======================================================================
'【引数】
' s = コントロールか文字列
'【戻り値】
' string = 文字列
'【処理】
' ・IsNull の場合、"" を返す文字変換をする。
'【著作権】
' CnvStr() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function CnvStr(s As Variant) As String
'** 文字変換
On Local Error Resume Next
if isnull(s) then
CnvStr = ""
else
CnvStr = ""
CnvStr = s
end if
On Local Error GoTo 0
End Function
'=======================================================================
' 数値チェック
'=======================================================================
'【引数】
' s = 【入出力】文字列
' ft = フォーマット
' "000000000"
' "########0"
' "########0.00"
' "###,###,##0"
' "###,###,##0.00"
' zr = ゼロチェック
' NO_ZERO = ゼロは許さない
' OK_ZERO = チェックしない
' ms = マイナスチェック
' NO_MINS = マイナスは許さない
' OK_MINS = チェックしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = 数値でない
'【処理】
' ・文字列の内容が数値なら、ft に従ってフォーマットする。
' ・ft が "" のときはフォーマットしない。
'【著作権】
' ChkVals() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkVals(s As String, ft As String, zr As Boolean, ms As Boolean) As Boolean
Dim dt As Double
'** エラーセット
ChkVals = False
'** 入力データ半角変換
s = Hankaku(s, HAN_HAN)
'** 数値データチェック
dt = Val(s)
If dt = 0 And s <> String(Len(s), "0") Then Exit Function
s = LTrim(Str(dt))
'** フォーマット、桁チェック
s = Format(s, ft)
If ft <> "" Then
If dt < 0 Then
If Len(s) > Len(ft) + 1 Then Exit Function
Else
If Len(s) > Len(ft) Then Exit Function
End If
End If
'** ゼロチェック
If zr And dt = 0 Then Exit Function
'** マイナスチェック
If ms And dt < 0 Then Exit Function
'** 正常セット
ChkVals = True
End Function
'=======================================================================
' 文字列チェック
'=======================================================================
'【引数】
' s = 【入出力】文字列
' ft = フォーマット(フォーマット文字列、または、最大バイト数。)
' "@@@@@@@@@"
' 最大バイト数
' han = 半角変換モード
' HAN_HAN = 半角にする
' HAN_LOW = 小文字半角にする
' HAN_UP = 大文字半角にする
' HAN_NO = 半角変換しない
' stype = 文字タイプ
' STYPE_NO = チッェクしない
' STYPE_HAN_A = 半角英数字でなければエラー
' STYPE_HAN = 半角でなければエラー
' STYPE_ZEN = 全角でなければエラー
' nu = "" チェック
' NO_NULL = "" は許さない
' OK_NULL = チェックしない
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・文字列の内容を、ft に従ってフォーマットする。
' ・ft が "" のときはフォーマットしない。
'【著作権】
' ChkStrs() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkStrs(s As String, ft As Variant, han As Integer, stype As Integer, nu As Boolean) As Boolean
Dim i As Integer
Dim a As String
'** エラーセット
ChkStrs = False
'** 入力データ半角変換
If han = HAN_NO Then
s = Trim(s)
Else
s = Hankaku(s, han)
End If
'** 無効文字チェック
If InStr(s, "'") > 0 Or InStr(s, Chr(&H22)) > 0 Or InStr(s, ",") > 0 Or InStr(s, chr(&H8168)) > 0 Then Exit Function
'** 半角全角チェック
Select Case stype
Case STYPE_HAN_A
For i = 1 To Len(s)
a = Mid(s, i, 1)
If (a < "0" Or a > "9") And (a < "A" Or a > "Z") And (a < "a" Or a > "z") Then
Exit Function
End If
Next
Case STYPE_HAN
If Len(s) < LenByte(s) Then Exit Function
Case STYPE_ZEN
If Len(s) <> LenByte(s) / 2 Then Exit Function
End Select
'** フォーマット、桁チェック
If IsNumeric(ft) Then
If ft < LenByte(s) Then Exit Function
Else
If ft <> "" And Len(s) <> Len(ft) Then Exit Function
s = Format(s, ft)
End If
'** "" チェック
If nu And s = "" Then Exit Function
'** 正常セット
ChkStrs = True
End Function
'=======================================================================
' フォーマットチェック
'=======================================================================
'【引数】
' ss = 【入出力】文字列
' ft = フォーマット(4 項目まで。1 項目の定義に "0" と "@" が混在し
' てはならない。"0" = 数字、"@" = 文字。)
' "0000-000000-000"
' "@@@@@@@@@-00"
' "@@@@@@@@@-@@-@@-@@"
' han = 半角変換モード
' HAN_HAN = 半角にする
' HAN_LOW = 小文字半角にする
' HAN_UP = 大文字半角にする
' z1 = ゼロチェック 1 項目
' NO_ZERO = ゼロは許さない
' OK_ZERO = チェックしない
' z2 = ゼロチェック 2 項目
' z3 = ゼロチェック 3 項目
' z4 = ゼロチェック 4 項目
'【戻り値】
' boolean = 処理結果
' TRUE = 正常終了
' FALSE = エラー
'【処理】
' ・文字列の内容を、ft に従ってフォーマットする。
' 但し、最大 4 項目のフォーマットしか出来ない。
'【著作権】
' ChkFormats() ver 1.00 Copyright (C) 1999 Y.SAK
'【履歴】
' 1999.04.17 sak ver 1.00 新規作成
'=======================================================================
Public Function ChkFormats(ss As String, ft As String, han As Integer, z1 As Boolean, z2 As Boolean, z3 As Boolean, z4 As Boolean) As Boolean
Dim sp As Integer
Dim mk As String
Dim fs As Boolean
Dim a As String
Dim s As String
Dim s1 As String
Dim s2 As String
Dim s3 As String
Dim s4 As String
Dim i As Integer
Dim j As Integer
'** 異常終了セット
ChkFormats = False
'** フォーマットマーク個数と種類計算
For i = 1 To Len(ft)
a = Mid(ft, i, 1)
If a = " " Or a = "," Or a = "." Or a = "/" Or a = ":" Or a = "-" Or a = "ｰ" Then
sp = sp + 1
mk = a
End If
If a = "@" Then fs = True
Next
'** データ整形
ss = Hankaku(ss, han)
s = ss
For i = 1 To Len(s)
a = Mid(s, i, 1)
If a = " " Or a = "," Or a = "." Or a = "/" Or a = ":" Or a = "-" Or a = "ｰ" Then Mid(s, i, 1) = mk
Next
'** セパレータ付け
i = InStr(s, mk)
If i = 0 Then
If fs Then
s = Left(s + Space(Len(ft)), Len(ft) - sp)
Else
s = Right(String(Len(ft), "0") + s, Len(ft) - sp)
End If
i = InStr(ft, mk)
s1 = Left(s, i - 1) + mk
i = i + 1
j = InStr(i, ft, mk)
If j = 0 Then
s2 = Mid(s, i - 1, Len(ft) - i + 1)
Else
s2 = Mid(s, i - 1, j - i) + mk
i = j + 1
j = InStr(i, ft, mk)
If j = 0 Then
s3 = Mid(s, i - 2, Len(ft) - i + 1)
Else
s3 = Mid(s, i - 2, j - i) + mk
i = j + 1
j = InStr(i, ft, mk)
If j = 0 Then
s4 = Mid(s, i - 3, Len(ft) - i + 1)
Else
s4 = Mid(s, i - 3, j - i) + mk
End If
End If
End If
s = s1 + s2 + s3 + s4
End If
'** 項目分割
s2 = ""
s3 = ""
s4 = ""
i = InStr(s, mk)
s1 = Left(s, i - 1)
i = i + 1
j = InStr(i, s, mk)
If j = 0 Then
s2 = Mid(s, i, Len(s) - i + 1)
Else
s2 = Mid(s, i, j - i)
i = j + 1
j = InStr(i, s, mk)
If j = 0 Then
s3 = Mid(s, i, Len(s) - i + 1)
Else
s3 = Mid(s, i, j - i)
i = j + 1
j = InStr(i, s, mk)
If j = 0 Then
s4 = Mid(s, i, Len(s) - i + 1)
Else
s4 = Mid(s, i, j - i)
End If
End If
End If
'** フォーマット
i = InStr(ft, mk)
If Left(ft, 1) = "@" Then
If ChkStrs(s1, Left(ft, i - 1), han, STYPE_HAN_A, False) = False Then
Exit Function
End If
Else
If ChkVals(s1, Left(ft, i - 1), z1, True) = False Then
Exit Function
End If
End If
i = i + 1
j = InStr(i, ft, mk)
If j = 0 Then
If Right(ft, 1) = "@" Then
If ChkStrs(s2, Mid(ft, i, Len(ft) - i + 1), han, STYPE_HAN_A, False) = False Then
Exit Function
End If
Else
If ChkVals(s2, Mid(ft, i, Len(ft) - i + 1), z2, True) = False Then
Exit Function
End If
End If
Else
If Mid(ft, i, j - 1) = "@" Then
If ChkStrs(s2, Mid(ft, i, j - i), han, STYPE_HAN_A, False) = False Then
Exit Function
End If
Else
If ChkVals(s2, Mid(ft, i, j - i), z2, True) = False Then
Exit Function
End If
End If
i = j + 1
j = InStr(i, ft, mk)
If j = 0 Then
If Right(ft, 1) = "@" Then
If ChkStrs(s3, Mid(ft, i, Len(ft) - i + 1), han, STYPE_HAN_A, False) = False Then
Exit Function
End If
Else
If ChkVals(s3, Mid(ft, i, Len(ft) - i + 1), z3, True) = False Then
Exit Function
End If
End If
Else
If Mid(ft, i, j - 1) = "@" Then
If ChkStrs(s3, Mid(ft, i, j - i), han, STYPE_HAN_A, False) = False Then
Exit Function
End If
Else
If ChkVals(s3, Mid(ft, i, j - i), z3, True) = False Then
Exit Function
End If
End If
i = j + 1
j = InStr(i, ft, mk)
If j = 0 Then
If Right(ft, 1) = "@" Then
If ChkStrs(s4, Mid(ft, i, Len(ft) - i + 1), han, STYPE_HAN_A, False) = False Then
Exit Function
End If
Else
If ChkVals(s4, Mid(ft, i, Len(ft) - i + 1), z4, True) = False Then
Exit Function
End If
End If
Else
If Mid(ft, i, j - 1) = "@" Then
If ChkStrs(s4, Mid(ft, i, j - i), han, STYPE_HAN_A, False) = False Then
Exit Function
End If
Else
If ChkVals(s4, Mid(ft, i, j - i), z4, True) = False Then
Exit Function
End If
End If
End If
End If
End If
s = s1
If s2 <> "" Then s = s + mk + s2
If s3 <> "" Then s = s + mk + s3
If s4 <> "" Then s = s + mk + s4
ss = s
'** 正常終了セット
ChkFormats = True
End Function
■VB テクニック編資料
■VB 入門編資料
■VB 基礎編資料
■VB ビジュアル編資料
Copyright (C) 1999-2024 Y.SAK