| |
お待たせしました
次のソースコードは次の条件で作成されています。
フォーム上に1個のテキストボックスと1個のコマンドボタンを配していますが、
ソースコードの改変により、複数のテキストボックスと1個のコマンドボタン
というフォームにも対応します。
禁則文字は何文字でも対応します。
○ フォームのソースコード
---- その1 フォームで共通で使用する変数の宣言 ----
Option Compare Database
Dim Detdata As Byte
---- その2 コマンドボタンのイベントプロシージャ ----
Private Sub CmdOutput_Click()
If Detdata > 0 Then
If Detdata And 1 Then
MsgBox "禁則文字があります", vbOKOnly + vbExclamation, "禁則検査"
End If
Else
MsgBox "禁則文字はありませんでした", , "禁則検査"
End If
Detdata = 0
End Sub
---- その3 テキストボックスのイベントプロシージャ ----
Private Sub TxtStr_AfterUpdate()
Dim StrDetData As Boolean
StrDetData = KinsokuDet(Me!txtstr.Value)
Select Case StrDetData
Case True
Detdata = Detdata Or 1
Case False
End Select
End Sub
---- その4 標準モジュールに作成する関数 ----
Public Function KinsokuDet(KensaStr) As Boolean
Dim i As Integer
Dim j As Integer
Dim h1 As String
Dim KensaData As String
Dim SQL01 As String
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Set cn = CurrentProject.Connection
SQL01 = "SELECT * FROM T_KINSOKU;"
rs.Open SQL01, cn, adOpenKeyset, adLockReadOnly
KinsokuDet = False
KensaData = KensaStr
KensaData = Trim(KensaData)
i = Len(KensaData)
j = 1
Do Until j > i
h1 = Mid(KensaData, j, 1)
rs.MoveFirst
Do Until rs.EOF
If h1 = rs!Data Then
KinsokuDet = True
End If
rs.MoveNext
Loop
j = j + 1
Loop
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing
End Function
---- 禁則文字テーブル 「T_KINSOKU」----
id data
1 !
2 @
3 #
4 $
5 %
・ ・
・ ・
・ ・
|
|
こもれび
- 04/8/22(日) 11:24 -
