SAK 図書館

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

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 >= "0" And a <= "9" Or a >= "A" And a <= "Z" Then
            z = z + Chr(Asc(a) + &H7DE1)
          Else
            If a >= "a" And a <= "z" 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 ビジュアル編資料
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索



Copyright (C) 1999-2017 Y.SAK