backup2.txt

来自「东通株式会社的人力资源管理系统。VB制作」· 文本 代码 · 共 177 行

Private Sub Command3_Click()
txtCode.Text = ""
txtName.Text = ""
txtCouse.Text = ""
txtAdd.Text = ""
txtTel.Text = ""
txtCode.Enabled = True
End Sub

Private Sub Command4_Click()
    Dim i As Long
    With fg
'        .Rows = 1
'        .Cols = 5
'        .FixedCols = 0
        
'        .TextMatrix(0, 0) = "No"
'        .TextMatrix(0, 1) = "Name"
        On Error GoTo Err1
        Dim rs As ADODB.Recordset
        Set rs = New ADODB.Recordset
        rs.CursorLocation = adUseClient
        rs.Open "select  HIKITORISAKI_CD,HIKITORISAKI_NM,HIKITORI_COUSE,ADDR,TEL from T_MHIKITORISAKI where HIKITORISAKI_CD like " & Trim(Val(txtCode.Text)) & " or HIKITORISAKI_NM like '" & Trim(txtName.Text) & "' or HIKITORI_COUSE like " & Trim(Val(txtCouse.Text)) & " or ADDR like '" & Trim(txtAdd.Text) & "' or TEL like '" & Trim(txtTel.Text) & "'", dbConn
        i = 0
          Do While Not rs.EOF
            i = i + 1
            .Rows = .Rows + 1
'            .TextMatrix(i, 0) = rs.Fields(0) 'HIKITORISAKI_CD
'            .TextMatrix(i, 1) = rs.Fields(1) 'HIKITORISAKI_NM
'            .TextMatrix(i, 2) = rs.Fields(2) 'HIKITORI_COUSE
'            .TextMatrix(i, 3) = rs.Fields(3) 'ADDR
'            .TextMatrix(i, 4) = rs.Fields(4) 'TEL
''            .Cell(flexcpText, i, 0, i, 0) = CStr(rs.Fields(0))  'sno
''            .Cell(flexcpText, i, 1, i, 1) = rs.Fields(1)  'sname
            For j = 0 To rs.Fields.Count - 1 Step 1
            If IsNull(rs.Fields(j)) Then
                .TextMatrix(i, j) = ""
            Else
                .TextMatrix(i, j) = rs.Fields(j)
            End If
            Next j

            rs.MoveNext
        
        Loop
        rs.Close
        Set rs = Nothing

End With
   Exit Sub
Err1:
MsgBox Err.Description, vbExclamation, Me.Caption
'rs.Close
Set rs = Nothing

End Sub

Private Sub Command5_Click()

Dim rs As ADODB.Recordset
        Set rs = New ADODB.Recordset
        rs.CursorLocation = adUseClient
        
On Error GoTo Err1
If txtCode.Enabled = True Then
        dbConn.Execute "insert into T_MHIKITORISAKI (HIKITORISAKI_CD,HIKITORISAKI_NM,HIKITORI_COUSE,ADDR,TEL) values (" & Trim(Val(txtCode.Text)) & ",'" & Trim(txtName.Text) & "'," & Trim(Val(txtCouse.Text)) & ",'" & Trim(txtAdd.Text) & "','" & Trim(Val(txtTel.Text)) & "')"
        MsgBox ("Insert ok!")
        
Else
        dbConn.Execute "update T_MHIKITORISAKI set HIKITORISAKI_NM='" & Trim(txtName.Text) & "',HIKITORI_COUSE=" & Trim(Val(txtCouse.Text)) & ",ADDR='" & Trim(txtAdd.Text) & "',TEL='" & Trim(Val(txtTel.Text)) & "' where HIKITORISAKI_CD=" & Trim(Val(txtCode.Text))
        MsgBox ("update ok!")
End If
        dbConn.Close
        Set rs = Nothing
     Exit Sub
Err1:
MsgBox Err.Description, vbExclamation, Me.Caption

End Sub

Private Sub Command6_Click()
dbConn.Close
End
End Sub


Private Sub fg_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
        fg.Row = fg.MouseRow
        'PopupMenu file1
    Else
        'Text1.Text = fg.TextMatrix(fg.MouseRow, fg.MouseCol)
        If fg.MouseRow <> 0 Then
        
        txtCode.Text = Trim(fg.TextMatrix(fg.MouseRow, 0))
        txtName.Text = Trim(fg.TextMatrix(fg.MouseRow, 1))
        txtCouse.Text = Trim(fg.TextMatrix(fg.MouseRow, 2))
        txtAdd.Text = Trim(fg.TextMatrix(fg.MouseRow, 3))
        txtTel.Text = Trim(fg.TextMatrix(fg.MouseRow, 4))
        
        txtCode.Enabled = False
        End If

    End If
End Sub

Private Sub txtAdd_KeyPress(KeyAscii As Integer)
If (KeyAscii <> vbKeyBack) And (KeyAscii <> vbKeyReturn) Then
If Len(txtCode.Text) >= 100 Then
KeyAscii = 0
End If
If InStr(Chr(KeyAscii), "'") Then
 KeyAscii = 0
End If
End If

End Sub

Private Sub txtCode_KeyPress(KeyAscii As Integer)
 Dim strValid     As String
          strValid = "0123456789"
    If (KeyAscii <> vbKeyBack) And (KeyAscii <> vbKeyReturn) Then
          If KeyAscii > 26 Then
                  If InStr(strValid, Chr(KeyAscii)) = 0 Then
                         KeyAscii = 0
                  End If
          End If
    If Len(txtCode.Text) >= 5 Then
    KeyAscii = 0
    End If
    End If
End Sub

Private Sub txtCouse_KeyPress(KeyAscii As Integer)
 Dim strValid     As String
          strValid = "0123456789"
    If (KeyAscii <> vbKeyBack) And (KeyAscii <> vbKeyReturn) Then
          If KeyAscii > 26 Then
                  If InStr(strValid, Chr(KeyAscii)) = 0 Then
                         KeyAscii = 0
                  End If
          End If
    If Len(txtCouse.Text) >= 5 Then
    KeyAscii = 0
    End If
    End If

End Sub

Private Sub txtName_KeyPress(KeyAscii As Integer)
If (KeyAscii <> vbKeyBack) And (KeyAscii <> vbKeyReturn) Then
If Len(txtName.Text) >= 100 Then
KeyAscii = 0
End If
If InStr(Chr(KeyAscii), "'") Then
 KeyAscii = 0
End If
End If
End Sub

Private Sub txtTel_KeyPress(KeyAscii As Integer)
 Dim strValid     As String
          strValid = "0123456789-"
    If (KeyAscii <> vbKeyBack) And (KeyAscii <> vbKeyReturn) Then
          If KeyAscii > 26 Then
                  If InStr(strValid, Chr(KeyAscii)) = 0 Then
                         KeyAscii = 0
                  End If
          End If
    If Len(txtTel.Text) >= 20 Then
    KeyAscii = 0
    End If
    End If
End Sub