form1.frm

一个关于企业工资管理的数据库应用的例子。

            TabIndex        =   18
            Top             =   720
            Width           =   975
         End
         Begin VB.Label Label11 
            Caption         =   "电话号码："
            Height          =   255
            Left            =   3360
            TabIndex        =   17
            Top             =   240
            Width           =   975
         End
         Begin VB.Label Label10 
            Caption         =   "政治面貌："
            Height          =   255
            Left            =   240
            TabIndex        =   11
            Top             =   4560
            Width           =   975
         End
         Begin VB.Label Label9 
            Caption         =   "婚姻状况："
            Height          =   255
            Left            =   240
            TabIndex        =   10
            Top             =   4080
            Width           =   975
         End
         Begin VB.Label Label8 
            Caption         =   "身份证号："
            Height          =   255
            Left            =   240
            TabIndex        =   9
            Top             =   3600
            Width           =   975
         End
         Begin VB.Label Label7 
            Caption         =   "专　　业："
            Height          =   255
            Left            =   240
            TabIndex        =   8
            Top             =   3120
            Width           =   975
         End
         Begin VB.Label Label6 
            Caption         =   "学　　历："
            Height          =   255
            Left            =   240
            TabIndex        =   7
            Top             =   2640
            Width           =   975
         End
         Begin VB.Label Label5 
            Caption         =   "出生年月："
            Height          =   255
            Left            =   240
            TabIndex        =   6
            Top             =   2160
            Width           =   975
         End
         Begin VB.Label Label4 
            Caption         =   "籍　　贯："
            Height          =   255
            Left            =   240
            TabIndex        =   5
            Top             =   1680
            Width           =   975
         End
         Begin VB.Label Label3 
            Caption         =   "性　　别："
            Height          =   255
            Left            =   240
            TabIndex        =   4
            Top             =   1200
            Width           =   975
         End
         Begin VB.Label Label2 
            Caption         =   "员工姓名："
            Height          =   255
            Left            =   240
            TabIndex        =   3
            Top             =   720
            Width           =   975
         End
         Begin VB.Label Label1 
            Caption         =   "员工编号："
            Height          =   255
            Left            =   240
            TabIndex        =   2
            Top             =   240
            Width           =   975
         End
      End
      Begin VB.Label Label25 
         Caption         =   "其它备注："
         Height          =   255
         Left            =   -74760
         TabIndex        =   43
         Top             =   3600
         Width           =   1335
      End
      Begin VB.Label Label24 
         Caption         =   "工作经验："
         Height          =   255
         Left            =   -74760
         TabIndex        =   41
         Top             =   2040
         Width           =   1095
      End
      Begin VB.Label Label23 
         Caption         =   "参加工作时间："
         Height          =   255
         Left            =   -71520
         TabIndex        =   40
         Top             =   1440
         Width           =   1335
      End
      Begin VB.Label Label22 
         Caption         =   "原工作单位："
         Height          =   375
         Left            =   -74760
         TabIndex        =   38
         Top             =   1440
         Width           =   1215
      End
      Begin VB.Label Label21 
         Caption         =   "原职务："
         Height          =   255
         Left            =   -71520
         TabIndex        =   36
         Top             =   720
         Width           =   855
      End
      Begin VB.Label Label20 
         Caption         =   "原身份："
         Height          =   255
         Left            =   -74640
         TabIndex        =   34
         Top             =   720
         Width           =   1095
      End
   End
End
Attribute VB_Name = "editinfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdsave_Click()
Dim StrSQL As String
StrSQL = "select 员工编号 from 员工档案 where 员工编号='" & Trim(Textbh.Text) & "'"
If Trim(Textysf.Text) <> Empty Then
    Call UpRsValue
On Error GoTo ErrSave
        RsRecord.Update
        Call Command4_Click
        MsgBox "数据已保存", , "保存成功"
        SSTab1.Tab = 0
        Call CmdState2
        Call TxtState1
Else
MsgBox "原身份不能为空", , "验证失败"
SSTab1.Tab = 1
End If
Exit Sub
ErrSave:
    Select Case Err.Number
        Case -2147217873
            MsgBox "员工编号已存在," & vbCrLf & "或性别、婚姻状况、部门、职称有空选项！", vbInformation + vbOKOnly, "输入错误"
            RsRecord.CancelUpdate
        Case Else
        MsgBox "错误描述：" & Err.Description & vbCrLf & "错误代码：" & Err.Number, vbCritical + vbOKOnly, "非法操作"
        Unload Me
    End Select
End Sub

Private Sub Command1_Click()
On Error GoTo ErrSave
RsRecord.AddNew

Call FormTxtValue2
Call TxtState
Call CmdState1
Dim conn As New ADODB.Connection
conn.Open "Provider=MSDASQL.1;Persist Security Info=False;Data Source=qygzgl"
If RsBranch.State = adStateClosed Then
RsBranch.Open "部门管理", conn, adOpenKeyset, adLockOptimistic, adCmdTable
End If
Set DataCombo1.RowSource = RsBranch
DataCombo1.BoundColumn = "部门名称"
DataCombo1.ListField = "部门名称"
Exit Sub
ErrSave:
    Select Case Err.Number
        Case -2147217873
            MsgBox "员工编号已存在," & vbCrLf & "或性别、婚姻状况、部门、职称有空选项！", vbInformation + vbOKOnly, "输入错误"
            RsRecord.CancelUpdate
        Case Else
        MsgBox "错误描述：" & Err.Description & vbCrLf & "错误代码：" & Err.Number, vbCritical + vbOKOnly, "非法操作"
        Unload Me
    End Select


End Sub
Private Sub Command2_Click()
Call CmdState1
Call TxtState
End Sub
Private Sub command3_click()
If MsgBox("确定要删除吗？", vbInformation + vbYesNo, "删除信息") = vbYes Then
    If RsRecord.RecordCount <> 0 Then
        RsRecord.Delete         '//删除记录
        Call Command4_Click
    Else
        MsgBox "当前没有任何记录", , "删除记录"
        Call FormTxtValue2      '//调用给文本框赋空值的过程
    End If
End If
End Sub
Private Sub Command4_Click()
If RsRecord.RecordCount <> 0 Then
    RsRecord.MoveNext           '//记录向下移一条
    If RsRecord.EOF Then
        RsRecord.MoveFirst      '//将记录移到第一行
    End If
    Call FormTxtValue1          '//调用将记录数据赋给文本框的过程
Else
MsgBox "当前没有任何记录", , "移动记录"
End If
End Sub
Private Sub command5_click()
Unload Me
editinfo.Show
End Sub
Private Sub FormTxtValue1()
Textbh.Text = RsRecord.Fields(0).value
Textxm.Text = RsRecord.Fields(1).value
Comboxb.Text = RsRecord.Fields(2).value
Textjg.Text = RsRecord.Fields(3).value
'DTPickercs.value = RsRecord.Fields(4).value
comboxl.Text = RsRecord.Fields(5).value
Textzy.Text = RsRecord.Fields(6).value
Textsf.Text = RsRecord.Fields(7).value
Combohy.Text = RsRecord.Fields(8).value
Textzz.Text = RsRecord.Fields(9).value
Textdh.Text = RsRecord.Fields(10).value
Textyb.Text = RsRecord.Fields(11).value
Textyx.Text = RsRecord.Fields(12).value
Textjt.Text = RsRecord.Fields(13).value
'DTPickerjr.value = RsRecord.Fields(14).value
'DTPickerqx.value = RsRecord.Fields(15).value
DataCombo1.Text = RsRecord.Fields(16).value
'DTPickerdr.value = RsRecord.Fields(17).value
Textzc.Text = RsRecord.Fields(18).value
'Textysf.Text = RsRecord.Fields(19).value
'Textyzw.Text = RsRecord.Fields(20).value
'Textydw.Text = RsRecord.Fields(21).value
'DTPickercj.value = RsRecord.Fields(22).value
'Textjy.Text = RsRecord.Fields(23).value
'Textbz.Text = RsRecord.Fields(24).value
End Sub
Private Sub FormTxtValue2()
Textbh.Text = Empty
Textxm.Text = Empty
Comboxb.Text = Empty
Textjg.Text = Empty
DTPickercs.value = Date
comboxl.Text = Empty
Textzy.Text = Empty
Textsf.Text = Empty
Combohy.Text = Empty
Textzz.Text = Empty
Textdh.Text = Empty
Textyb.Text = Empty
Textyx.Text = Empty
Textjt.Text = Empty
DTPickerjr.value = Date
DTPickerqx.value = Date
DataCombo1.Text = Empty
DTPickerdr.value = Date
Textzc.Text = Empty
Textysf.Text = Empty
Textyzw.Text = Empty
Textydw.Text = Empty
DTPickercj.value = Date
Textjy.Text = Empty
Textbz.Text = Empty
End Sub
Private Sub TxtState()
Textbh.Enabled = True
Textxm.Enabled = True
Comboxb.Enabled = True
Textjg.Enabled = True
DTPickercs.Enabled = True
comboxl.Enabled = True
Textzy.Enabled = True
Textsf.Enabled = True
Combohy.Enabled = True
Textzz.Enabled = True
Textdh.Enabled = True
Textyb.Enabled = True
Textyx.Enabled = True
Textjt.Enabled = True
DTPickerjr.Enabled = True
DTPickerqx.Enabled = True
DataCombo1.Enabled = True
DTPickerdr.Enabled = True
Textzc.Enabled = True
Textysf.Enabled = True
Textyzw.Enabled = True
Textydw.Enabled = True
DTPickercj.Enabled = True
Textjy.Enabled = True
Textbz.Enabled = True
End Sub
Private Sub TxtState1()
Textbh.Enabled = False
Textxm.Enabled = False
DataCombo1.Enabled = False
Textjg.Enabled = False
DTPickercs.Enabled = False
comboxl.Enabled = False
Textzy.Enabled = False
Textsf.Enabled = False
Combohy.Enabled = False
Textzz.Enabled = False
Textdh.Enabled = False
Textyb.Enabled = False
Textyx.Enabled = False
Textjt.Enabled = False
DTPickerjr.Enabled = False
DTPickerqx.Enabled = False
DataCombo1.Enabled = False
DTPickerdr.Enabled = False
Textzc.Enabled = False
Textysf.Enabled = False
Textyzw.Enabled = False
Textydw.Enabled = False
DTPickercj.Enabled = False
Textjy.Enabled = False
Textbz.Enabled = False
End Sub
Private Sub CmdState1()
Command1.Visible = False
Command2.Visible = False
Command3.Visible = False
Command4.Visible = False
cmdsave.Visible = True
Command5.Enabled = True
End Sub
Private Sub CmdState2()
Command1.Visible = True
Command2.Visible = True
Command3.Visible = True
Command4.Visible = True
cmdsave.Visible = False
Command5.Enabled = True
End Sub
Private Sub UpRsValue()
RsRecord.Fields(0).value = Textbh.Text
RsRecord.Fields(1).value = Textxm.Text
RsRecord.Fields(2).value = Comboxb.Text
RsRecord.Fields(3).value = Textjg.Text
RsRecord.Fields(4).value = DTPickercs.value
RsRecord.Fields(5).value = comboxl.Text
RsRecord.Fields(6).value = Textzy.Text
RsRecord.Fields(7).value = Textsf.Text
RsRecord.Fields(8).value = Combohy.Text
RsRecord.Fields(9).value = Textzz.Text
RsRecord.Fields(10).value = Textdh.Text
RsRecord.Fields(11).value = Textyb.Text
RsRecord.Fields(12).value = Textyx.Text
RsRecord.Fields(13).value = Textjt.Text
RsRecord.Fields(14).value = DTPickerjr.value
RsRecord.Fields(15).value = DTPickerqx.value
RsRecord.Fields(16).value = DataCombo1.Text
RsRecord.Fields(17).value = DTPickerdr.value
RsRecord.Fields(18).value = Textzc.Text
RsRecord.Fields(19).value = Textysf.Text
RsRecord.Fields(20).value = Textyzw.Text
RsRecord.Fields(21).value = Textydw.Text
RsRecord.Fields(22).value = DTPickercj.value
RsRecord.Fields(23).value = Textjy.Text
RsRecord.Fields(24).value = Textbz.Text
End Sub

Private Sub Command6_Click()
DataReport1.Show
End Sub

Private Sub Form_Load()
Dim conn As New ADODB.Connection
conn.Open "Provider=MSDASQL.1;Persist Security Info=False;Data Source=qygzgl"
If RsRecord.State = adStateClosed Then
RsRecord.Open "员工档案表", conn, adOpenKeyset, adLockOptimistic, adCmdTable
End If
If RsRecord.RecordCount > 0 Then
Call FormTxtValue1
Else
Call FormTxtValue2
End If
End Sub