|
|
' ****************************************************
' 第1会話から第2会話への画面遷移
' ****************************************************
Private Sub btn確認1会話目_Click()
If Not CheckHead() Then
Exit Sub
End If
Call HeadProtect
Call BodyEnable
End Sub
| |
|
|
' ****************************************************
' 第1会話のチェック
' ****************************************************
Private Function CheckHead()
' 処理区分のチェック
If InStr("129", txt処理区分.Text) = 0 Then
MsgBox ("処理区分は、1,2 または 9 を指定して下さい")
CheckHead = False
txt処理区分.SetFocus
txt処理区分.SelStart = 0
txt処理区分.SelLength = Len(txt処理区分.Text)
Exit Function
End If
' コードのチェック
If Trim(txtコード.Text) = "" Then
MsgBox ("コードを入力して下さい")
CheckHead = False
txtコード.SetFocus
Exit Function
End If
' データベースの処理
Dim objRs As Object
Dim strSql As String
Dim bEOF As Boolean
Set objRs = CreateObject("ADODB.Recordset")
strSql = "select * from 学生マスタ where コード ='" & txtコード.Text & "'"
objRs.Open strSql, g_objCn
bEOF = objRs.EOF
objRs.Close
Set objRs = Nothing
' 登録処理の存在チェック
If txt処理区分.Text = "1" Then
If Not bEOF Then
MsgBox ("既に存在しています")
CheckHead = False
txtコード.SetFocus
txtコード.SelStart = 0
txtコード.SelLength = Len(txtコード.Text)
Exit Function
End If
End If
CheckHead = True
End Function
| |
|
|
2会話目の確認でエラーチェック --> 確認 --> 更新 --> 画面リセット |
|
|
' ****************************************************
' 第2会話のコントロール
' ****************************************************
Private Sub btn確認2会話目_Click()
If Not CheckBody() Then
Exit Sub
End If
If MsgBox("更新しますか?", vbOKCancel) = vbCancel Then
Exit Sub
End If
If UpdateData() Then
Call BodyClear
Call BodyProtect
Call HeadEnable
txtコード.Text = ""
txtコード.SetFocus
End If
End Sub
| |
|
|
' ****************************************************
' 第2会話のチェック
' ****************************************************
Private Function CheckBody()
' 名前
With txt名前
If Trim(.Text) = "" Then
Call MsgBox("必須入力です", vbOKOnly, "名前")
.SetFocus
CheckBody = False
Exit Function
End If
End With
' 学年
With txt学年
If Trim(.Text) = "" Then
Call MsgBox("必須入力です", vbOKOnly, "学年")
.SetFocus
CheckBody = False
Exit Function
End If
End With
CheckBody = True
End Function
| |
|
|
' ****************************************************
' 更新
' ****************************************************
Private Function UpdateData()
Dim objRs As Object
Dim strSql As String
Dim bEOF As Boolean
' レコードセットオブジェクト作成
Set objRs = CreateObject("ADODB.Recordset")
' レコードセットを更新可能にする
objRs.LockType = 3
' レコードセット取得用 SELECT
strSql = "select * from 学生マスタ where コード ='" & txtコード.Text & "'"
' レコードセット取得
objRs.Open strSql, g_objCn
' 登録処理の存在チェック
If txt処理区分.Text = "1" Then
' レコード存在の再チェック
If Not objRs.EOF Then
MsgBox ("既に存在しています")
objRs.Close
Set objRs = Nothing
UpdateData = False
Exit Function
End If
' 新規行の挿入
objRs.AddNew
' キーのセット
objRs.Fields("コード").Value = txtコード.Text
' 名前
objRs.Fields("名前").Value = txt名前.Text
' 学年
objRs.Fields("学年").Value = txt学年.Text
' 誕生日
If Trim(txt誕生日) = "" Then
objRs.Fields("誕生日").Value = Null
Else
objRs.Fields("誕生日").Value = _
Left(txt誕生日.Text, 4) & "/" & _
Mid(txt誕生日.Text, 6, 2) & "/" & _
Right(txt誕生日.Text, 2)
End If
' 電話番号
If Trim(txt電話番号) = "" Then
objRs.Fields("電話番号").Value = Null
Else
objRs.Fields("電話番号").Value = txt電話番号.Text
End If
' レコードの更新
objRs.Update
End If
' レコードセットを閉じる
objRs.Close
' オブジェクトを開放
Set objRs = Nothing
' 静止点の確立
g_objCn.CommitTrans
' トランザクションの開始
g_objCn.BeginTrans
' 関数の戻り値
UpdateData = True
End Function
| |
|
|
|