|
' ***************************************************
' 初期処理
' ***************************************************
Private Sub Form_Load()
' 接続
Set Cn = lbMDB_DBConnect(App.Path & "\" & "db.mdb")
' Set Cn = lbSQS_DBConnect("sv20", "hdb", "sa", "")
' コントロール属性の初期化
Call InitControl
' 画面クリア
ClearControl
End Sub
' ***************************************************
' 終了処理
' ***************************************************
Private Sub Form_Unload(Cancel As Integer)
Call lbDBClose(Cn)
End Sub
' ***************************************************
' 画面初期化
' ***************************************************
Private Function ClearControl()
' コントロールのクリア
Call lbClear(Form1)
Call lbDisableObjects(Form1, "1", False)
Call lbDisableObjects(Form1, "2", True)
Form1.Show
コード.SetFocus
End Function
' ***************************************************
' 画面全体のチェック
' ***************************************************
Public Function CheckData()
If Trim(名称.Text) = "" Then
MsgBox ("必須入力です")
Call lbSelectText(名称)
名称.SetFocus
CheckData = False
Exit Function
End If
If 担当者コード.Text = "" Then
MsgBox ("必須入力です")
Call lbSelectText(担当者コード)
担当者コード.SetFocus
CheckData = False
Exit Function
End If
CheckData = True
End Function
' ***************************************************
' 参照ボタン
' ***************************************************
Private Sub コード参照_Click()
' エラーチェック
If Trim(コード.Text) = "" Then
MsgBox ("コードを入力して下さい")
Call lbSelectText(コード)
コード.SetFocus
Exit Sub
End If
' SQL 作成
SqlQuery = "select 得意先マスタ.コード,"
SqlQuery = SqlQuery & "得意先マスタ.名称 as 得意先名,"
SqlQuery = SqlQuery & "担当者コード,創立記念日,売掛残,締区分,"
SqlQuery = SqlQuery & "担当者マスタ.コード,"
SqlQuery = SqlQuery & "担当者マスタ.名称 as 担当者名"
SqlQuery = SqlQuery & " from 得意先マスタ,担当者マスタ"
SqlQuery = SqlQuery & " where "
SqlQuery = SqlQuery & " 担当者コード = 担当者マスタ.コード"
SqlQuery = SqlQuery & " and 得意先マスタ.コード = " & Ss(コード.Text)
If Not lbDBGet(Cn, Rs, SqlQuery, False) Then
更新モード.Caption = "新規"
削除フラグ.Enabled = False
Else
更新モード.Caption = "修正"
削除フラグ.Enabled = True
名称.Text = Rs.Fields("得意先名").Value
売掛残.Text = Format(Rs.Fields("売掛残").Value & "", "###,###,##0")
担当者コード.Text = Rs.Fields("担当者コード").Value & ""
担当者名.Caption = Rs.Fields("担当者名").Value & ""
創立記念日.Text = Rs.Fields("創立記念日").Value & ""
Dim idx As Integer
For idx = 0 To 締区分.ListCount - 1
If 締区分.ItemData(idx) = Rs.Fields("締区分").Value Then
締区分.ListIndex = idx
Exit For
End If
Next
End If
' 画面遷移
Call lbDisableObjects(Form1, "2", False)
Call lbDisableObjects(Form1, "1", True)
' 第2パス初期項目
名称.SetFocus
' レコードを閉じる
Call lbDBClose(Rs)
End Sub
' ***************************************************
' 更新ボタン
' ***************************************************
Private Sub 更新_Click()
Dim strMessage As String
Dim nType As Integer
' 画面全体のチェック
If CheckData = False Then
Exit Sub
End If
' メッセージの調整
If 削除フラグ.Value = 1 Then
strMessage = "削除しますか?"
nType = vbOKCancel + 48
Else
strMessage = "更新しますか?"
nType = vbOKCancel
End If
' 更新確認
If MsgBox(strMessage, nType, "確認") <> vbOK Then
Exit Sub
End If
' SQL 作成
SqlQuery = "select * from 得意先マスタ where コード = " & Ss(コード.Text)
Call lbDBGet(Cn, Rs, SqlQuery, True)
If 削除フラグ.Value = 1 And Not Rs.EOF Then
Rs.Delete
Else
If Rs.EOF Then
Rs.AddNew
' コード
Rs.Fields("コード").Value = コード.Text
End If
' 名称
Rs.Fields("名称").Value = 名称.Text
Rs.Fields("担当者コード").Value = 担当者コード.Text
If Trim(創立記念日.Text) = "" Then
Rs.Fields("創立記念日").Value = Null
Else
Rs.Fields("創立記念日").Value = 創立記念日.Text
End If
' 売掛残
If 売掛残.Text = "" Then
Rs.Fields("売掛残").Value = 0
Else
Rs.Fields("売掛残").Value = 売掛残.Text
End If
If 締区分.ListIndex <> -1 Then
Rs.Fields("締区分").Value = 締区分.ItemData(締区分.ListIndex)
End If
Rs.Update
End If
If Err.Number <> 0 Then
MsgBox ("エラーです")
Call lbDBClose(Rs)
Exit Sub
End If
' レコードを閉じる
Call lbDBClose(Rs)
Call ClearControl
End Sub
' ***************************************************
' 担当者の参照ダイアログ呼び出し
' ***************************************************
Private Sub 担当者参照_Click()
Form2.Show vbModal
End Sub
' ******************************************
' コントロールの初期化
' ******************************************
Private Function InitControl()
Call lbDisableObjects(Form1, "1", False)
' コード
With コード
.MaxLength = 4
End With
' 参照ボタン
With コード参照
End With
Call lbDisableObjects(Form1, "2", True)
' 名称
With 名称
.MaxLength = 50
End With
' 担当者コード
With 担当者コード
.MaxLength = 4
End With
' 創立記念日
With 創立記念日
.MaxLength = 10
End With
' 参照ボタン2
With 担当者参照
End With
' 売掛残
With 売掛残
.MaxLength = 9
End With
' 締区分
With 締区分
Call lbSetComboBox( _
締区分, _
"select コード,名称 from コード名称 where 区分 = '0001'")
End With
' 更新ボタン
With 更新
End With
' 削除チェック
With 削除フラグ
End With
End Function
' ***************************************************
' フォーカス
' ***************************************************
Private Sub コード_GotFocus()
' IME OFF
コード.IMEMode = 2
End Sub
' ***************************************************
' フォーカスが他のコントロールへ行く直前
' ***************************************************
Private Sub コード_Validate(Cancel As Boolean)
Call lbEditZeroText(コード)
If Not lbCheckString(コード.Text, "0123456789") Then
MsgBox ("入力が誤っています")
Call lbSelectText(コード)
Cancel = True
End If
End Sub
' ***************************************************
' フォーカスが他のコントロールへ行く直前
' ***************************************************
Private Sub 名称_Validate(Cancel As Boolean)
If Not lbCheckTextMax(名称) Then
MsgBox ("入力した文字列が長すぎます")
Call lbSelectText(名称)
Cancel = True
End If
End Sub
' ***************************************************
' フォーカスが他のコントロールへ行く直前
' ***************************************************
Private Sub 担当者コード_Validate(Cancel As Boolean)
If 担当者コード.Text = "" Then
Exit Sub
End If
Call lbEditZeroText(担当者コード)
If Not lbCheckString(担当者コード.Text, "0123456789") Then
MsgBox ("入力が誤っています")
Call lbSelectText(担当者コード)
Cancel = True
Exit Sub
End If
' SQL作成
SqlQuery = "select *"
SqlQuery = SqlQuery & " from 担当者マスタ"
SqlQuery = SqlQuery & " where "
SqlQuery = SqlQuery & " コード = '" & 担当者コード.Text & "'"
If Not lbDBGet(Cn, Rs, SqlQuery, False) Then
MsgBox ("担当者マスタにデータが存在しません")
Call lbSelectText(担当者コード)
Cancel = True
Else
担当者名.Caption = Rs.Fields("名称").Value & ""
End If
Call lbDBClose(Rs)
End Sub
' ***************************************************
' 日付編集(選択)
' ***************************************************
Private Sub 創立記念日_GotFocus()
創立記念日.Text = Replace(創立記念日.Text, "/", "")
Call lbSelectText(創立記念日)
End Sub
' ***************************************************
' 日付編集(9999/99/99)
' ***************************************************
Private Sub 創立記念日_LostFocus()
If 創立記念日.Text <> "" Then
創立記念日.Text = Format(創立記念日.Text, "0000/00/00")
End If
End Sub
' ***************************************************
' 数値編集(選択)
' ***************************************************
Private Sub 売掛残_GotFocus()
売掛残.Text = Replace(売掛残.Text, ",", "")
End Sub
' ***************************************************
' 数値編集(ZZZ,ZZZ,ZZ9)
' ***************************************************
Private Sub 売掛残_LostFocus()
売掛残.Text = Format(売掛残.Text, "###,###,##0")
End Sub
' ***************************************************
' 日付チェック
' ***************************************************
Private Sub 創立記念日_Validate(Cancel As Boolean)
Dim nRet As Long
If Trim(創立記念日.Text) = "" Then
Exit Sub
End If
nRet = lbDateCheck(創立記念日.Text)
Select Case nRet
Case 1
MsgBox ("8桁の入力を行って下さい")
Call lbSelectText(創立記念日)
Cancel = True
Case 2
MsgBox ("月の入力が誤りです")
Call lbSelectText(創立記念日)
Cancel = True
Case 3
MsgBox ("日の入力が誤りです")
Call lbSelectText(創立記念日)
Cancel = True
End Select
End Sub
' ***************************************************
' キャンセル(メニュー)
' ***************************************************
Private Sub キャンセル_Click()
Call ClearControl
End Sub
' ***************************************************
' ENTER -> TAB
' ***************************************************
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
Call keybd_event(VK_TAB, 0, 0, 0)
Call keybd_event(VK_TAB, 0, KEYEVENTF_KEYUP, 0)
End If
End Sub
| |