★★試験用ベース(Form1とForm2)★★

  Form1



  
' ***************************************************
' 初期処理
' ***************************************************
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

  

  Form2



  
' ******************************************************
' 検索ボタン
' ******************************************************
Private Sub Command1_Click()

    Dim Row As Integer

    SqlQuery = "select * from 担当者マスタ"
    If Text1.Text <> "" Then
        SqlQuery = SqlQuery & " where 名称 like " & Ss("%" & Text1.Text & "%")
    End If
    
    Row = 0
    If lbDBGet(Cn, Rs, SqlQuery, False) Then
        Do While Not Rs.EOF
            Row = Row + 1
            Grid.Rows = Row + 1
            Grid.TextMatrix(Row, 1) = Rs.Fields("コード").Value
            Grid.TextMatrix(Row, 2) = Rs.Fields("名称").Value
            Rs.MoveNext
        Loop
    End If

    lbDBClose (Rs)

End Sub

' ******************************************************
' 初期処理
' ******************************************************
Private Sub Form_Load()

    With Grid
    
        ' グリッド全体の設定
        .ScrollTrack = True
        .AllowUserResizing = flexResizeColumns
        .SelectionMode = flexSelectionByRow
    
        ' 固定タイトルを含めた列数
        .Cols = 3
    
        ' 固定タイトルを含めた行数
        .Rows = 50
    
        ' 固定タイトル行へ文字列セット
        .FormatString = "|コード|名称"
    
        ' 行ヘッダの幅
        .ColWidth(0) = 300
    
        ' 列幅
        .ColWidth(1) = 800
        .ColWidth(2) = 2000
        
        ' 列のテキスト配置方法
        .ColAlignment(1) = 1
        .ColAlignment(2) = 1

    End With


End Sub

' ******************************************************
' 選択処理
' ******************************************************
Private Sub Grid_DblClick()

    Form1.担当者コード.Text = Grid.TextMatrix(Grid.Row, 1)
    Form1.担当者名.Caption = Grid.TextMatrix(Grid.Row, 2)
    Unload Me

End Sub

  











   SQLの窓    create:2002/12/03  update:2014/09/07   管理者用(要ログイン)





フリーフォントWEBサービス

SQLの窓WEBサービス

SQLの窓フリーソフト

写真素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ