frmrenmd.frm

学院MIS管理系统,适合大部分毕业生,请大家支持

            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0080FFFF&
         Height          =   375
         Index           =   2
         Left            =   3720
         TabIndex        =   26
         Top             =   980
         Width           =   975
      End
      Begin VB.Label label 
         BackColor       =   &H8000000D&
         BackStyle       =   0  'Transparent
         Caption         =   "性别"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0080FFFF&
         Height          =   375
         Index           =   1
         Left            =   360
         TabIndex        =   25
         Top             =   980
         Width           =   975
      End
      Begin VB.Label label 
         BackColor       =   &H8000000D&
         BackStyle       =   0  'Transparent
         Caption         =   "姓名"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0080FFFF&
         Height          =   375
         Index           =   0
         Left            =   3720
         TabIndex        =   24
         Top             =   360
         Width           =   975
      End
   End
   Begin VB.CommandButton CmdEdit 
      Caption         =   "修改记录"
      Height          =   375
      Left            =   480
      TabIndex        =   19
      Top             =   7440
      Width           =   1000
   End
   Begin VB.CommandButton CmdNext 
      Caption         =   "下一条记录"
      Height          =   375
      Left            =   3840
      TabIndex        =   17
      Top             =   6360
      Width           =   1200
   End
   Begin VB.Frame Frame2 
      BackColor       =   &H8000000D&
      Caption         =   "修改人员信息"
      ForeColor       =   &H0080FFFF&
      Height          =   975
      Left            =   120
      TabIndex        =   14
      Top             =   7080
      Width           =   6975
      Begin VB.CommandButton cmdtui 
         Caption         =   "退出"
         Height          =   375
         Left            =   6120
         TabIndex        =   38
         Top             =   360
         Width           =   600
      End
      Begin VB.CommandButton CmdDelete 
         Caption         =   "删除记录"
         Height          =   375
         Left            =   4680
         TabIndex        =   22
         Top             =   360
         Width           =   1000
      End
      Begin VB.CommandButton CmdCancel 
         Caption         =   "取消修改"
         Height          =   375
         Left            =   3240
         TabIndex        =   21
         Top             =   360
         Width           =   1000
      End
      Begin VB.CommandButton CmdUpdate 
         Caption         =   "确定修改"
         Height          =   375
         Left            =   1800
         TabIndex        =   20
         Top             =   360
         Width           =   1000
      End
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H8000000D&
      Caption         =   "查看人员信息"
      ForeColor       =   &H0080FFFF&
      Height          =   975
      Left            =   120
      TabIndex        =   0
      Top             =   6000
      Width           =   6975
      Begin VB.CommandButton CmdLast 
         Caption         =   "最后记录"
         Height          =   375
         Left            =   5400
         TabIndex        =   18
         Top             =   360
         Width           =   1200
      End
      Begin VB.CommandButton CmdPrevious 
         Caption         =   "上一条记录"
         Height          =   375
         Left            =   2040
         TabIndex        =   16
         Top             =   360
         Width           =   1200
      End
      Begin VB.CommandButton CmdFirst 
         Caption         =   "最前记录"
         Height          =   375
         Left            =   360
         TabIndex        =   15
         Top             =   360
         Width           =   1200
      End
   End
End
Attribute VB_Name = "FrmRenmd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mrc As ADODB.Recordset
Dim mcclean As Boolean
'在对话框中显示数据库中信息
Public Sub viewData()
     txtbh.Text = Trim(mrc.Fields(0))
     txtName.Text = Trim(mrc.Fields(1))
     comsex.Text = Trim(mrc.Fields(2))
     Comzhch.Text = Trim(mrc.Fields(3))
     TxtZhw.Text = Trim(mrc.Fields(4))
     Comxue.Text = Trim(mrc.Fields(5))
     TxtJysh.Text = Trim(mrc.Fields(6))
     TxtBorndate.Text = Trim(mrc.Fields(7))
     Commian.Text = Trim(mrc.Fields(8))
     Txtgongzuo.Text = Trim(mrc.Fields(9))
     Txtyuanxi.Text = Trim(mrc.Fields(10))
     Txtjianzhi.Text = Trim(mrc.Fields(11))
     TxtJg.Text = Trim(mrc.Fields(12))
     TxtShfzh.Text = Trim(mrc.Fields(13))
End Sub

Private Sub CmdCancel_Click()
'判断是否处于修改状态
     Call reflashform
End Sub
Private Sub CmdDelete_Click()
    Dim txtSQL As String
    Dim MsgText As String
    mrc.Close
    txtSQL = "select * from personnel_infor where Personnel_id = '" & Trim(txtbh.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    '先按编号查询到人员信息，再删除
    If mrc.BOF Then
          MsgBox "数据库中没有此人员信息！", vbOKOnly + vbExclamation, "无法删除"
          Call reflashform
          Exit Sub
    Else
         Call viewData
          '提示是否删除
          str2$ = MsgBox("是否删除当前记录？", vbOKCancel + vbQuestion, "删除当前记录")
        If str2$ = vbOK Then
          mrc.Delete
          MsgBox "删除成功！", vbOKOnly + vbExclamation, "警告"
          Call reflashform
        Else
          Call reflashform
        End If
     
    End If
       
End Sub
'使 “修改人员”按钮具有按’人员编号‘查询功能
Private Sub Cmdedit_Click()
    Dim txtSQL As String
    Dim MsgText As String
    mrc.Close
    txtSQL = "select * from personnel_infor where Personnel_id = '" & Trim(txtbh.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.BOF Then
          MsgBox "数据库中没有此人员信息！", vbOKOnly + vbExclamation, "无法修改"
          Call reflashform
          Exit Sub
    Else
        Call viewData
    
    mcclean = False
    Frame1.Enabled = False
   '使移动记录按钮失效
    CmdFirst.Enabled = False
    CmdPrevious.Enabled = False
    Cmdnext.Enabled = False
    CmdLast.Enabled = False
    '是各个文本框有效
          Frame2.Enabled = True
          txtbh.Enabled = True
          txtName.Enabled = True
          comsex.Enabled = True
          Comzhch.Enabled = True
          TxtZhw.Enabled = True
          Comxue.Enabled = True
          TxtJysh.Enabled = True
          TxtBorndate.Enabled = True
          Commian.Enabled = True
          Txtgongzuo.Enabled = True
          Txtyuanxi.Enabled = True
          Txtjianzhi.Enabled = True
          TxtJg.Enabled = True
          TxtShfzh.Enabled = True
          Frame1.Enabled = False
          Cmdedit.Enabled = False
          CmdDelete.Enabled = False
          CmdCancel.Enabled = True
          cmdtui.Enabled = False
          CmdUpdate.Enabled = True
   End If
End Sub

Private Sub CmdFirst_Click()
  mrc.MoveFirst
  Call viewData
End Sub

Private Sub CmdLast_Click()
   mrc.MoveLast
   Call viewData
End Sub


Private Sub Cmdnext_Click()
mrc.MoveNext
If mrc.EOF Then
mrc.MoveFirst
End If
 Call viewData
End Sub

Private Sub CmdPrevious_Click()
    mrc.MovePrevious
    If mrc.BOF Then
    mrc.MoveLast
    End If
    Call viewData
    
End Sub
Private Sub cmdtui_Click()
Unload Me
End Sub

Private Sub CmdUpdate_Click()
   Dim txtSQL As String
   Dim MsgText As String
   Dim mrcc As ADODB.Recordset
      
   '判断是否输入编号
     If Not Testtxt(txtbh.Text) Then
        MsgBox "请输入编号！", vbOKOnly + vbExclamation, "警告"
      txtbh.SetFocus
      Exit Sub
     End If
     '判断性别输入是否符合要求
  If Testtxt(comsex.Text) Then
     If Trim(comsex.Text) = "男" Or Trim(comsex.Text) = "女" Then
     Else
      MsgBox "性别只输入 男 或 女！", vbOKOnly + vbExclamation, "警告"
      comsex.SetFocus
      Exit Sub
     End If
  End If
   '判断身份证号码输入是否正确
   If Testtxt(TxtShfzh.Text) Then
     If Len(Trim(TxtShfzh.Text)) <> 15 And Len(Trim(TxtShfzh.Text)) <> 18 Then
       MsgBox "身份证号码长度不正确！", vbOKOnly + vbExclamation, "警告"
       TxtShfzh.SetFocus
     Exit Sub
     Else
      If Not IsNumeric(left$(TxtShfzh.Text, 17)) Then
       MsgBox "身份证号码不正确！", vbOKOnly + vbExclamation, "警告"
       TxtShfzh.SetFocus
      Exit Sub
     End If
     End If
  End If
       '判断是否输入出生日期？
      If Testtxt(TxtBorndate.Text) Then
       '判断输入的出生日期是否按照格式
             If Not IsDate(TxtBorndate.Text) Then
               MsgBox "出生日期应输入日期格式（yyyy—mm—dd）！", vbOKOnly + vbExclamation, "警告"
               TxtBorndate.SetFocus
                 Exit Sub
             Else
                 TxtBorndate = Format(TxtBorndate, "yyyy-mm-dd")
             End If
      Else
         TxtBorndate.Text = "1900-01-01"
         TxtBorndate = Format(TxtBorndate, "yyyy-mm-dd")
      End If
        '判断输入的工作日期是否按照格式
        If Testtxt(Txtgongzuo.Text) Then
             If Not IsDate(Txtgongzuo.Text) Then
               MsgBox "工作时间应输入日期格式（yyyy—mm—dd）！", vbOKOnly + vbExclamation, "警告"
               Txtgongzuo.SetFocus
                 Exit Sub
             Else
             Txtgongzuo = Format(Txtgongzuo, "yyyy-mm-dd")
             End If
        Else
         Txtgongzuo.Text = "1900-01-01"
        Txtgongzuo = Format(Txtgongzuo, "yyyy-mm-dd")
        End If
   '判断编号是否重复
    txtSQL = "select * from personnel_infor where Personnel_id = '" & Trim(txtbh.Text) & "'"
    Set mrcc = ExecuteSQL(txtSQL, MsgText)
    If mrcc.EOF = False Then
        If mrcc.Fields(0) = mrc.Fields(0) Then
   '如果查询到的编号跟mrc的相同，则不算重复。因为mrc是要更新的对象，更新前要删除的
        Else
        MsgBox "人员编号重复，请重新输入！", vbOKOnly + vbExclamation, "警告"
        mrcc.Close
        txtbh.SetFocus
        Exit Sub
        End If
    End If
       mrcc.Close
     '将要更新的记录删除后，再添加新记录，代表更新
       mrc.Delete
       mrc.AddNew
       mrc.Fields(0) = Trim(txtbh.Text)
       mrc.Fields(1) = Trim(txtName.Text)
       mrc.Fields(2) = Trim(comsex.Text)
       mrc.Fields(3) = Trim(Comzhch.Text)
       mrc.Fields(4) = Trim(TxtZhw.Text)
       mrc.Fields(5) = Trim(Comxue.Text)
       mrc.Fields(6) = Trim(TxtJysh.Text)
       mrc.Fields(7) = Trim(TxtBorndate.Text)
       mrc.Fields(8) = Trim(Commian.Text)
       mrc.Fields(9) = Trim(Txtgongzuo.Text)
       mrc.Fields(10) = Trim(Txtyuanxi.Text)
       mrc.Fields(11) = Trim(Txtjianzhi.Text)
       mrc.Fields(12) = Trim(TxtJg.Text)
       mrc.Fields(13) = Trim(TxtShfzh.Text)
       mrc.Update
          MsgBox "修改人员信息成功！", vbOKOnly + vbExclamation, "修改人员信息"
          
     Call reflashform
        
End Sub
'用于刷新窗体
Public Sub reflashform()
   Dim txtSQL As String
   Dim MsgText As String
   txtSQL = "select * from personnel_Infor"
   Set mrc = ExecuteSQL(txtSQL, MsgText)
      If mrc.BOF = True Then
         str2$ = MsgBox("所有人员信息被删除完毕！" & Chr(13) & "      添加人员信息？", vbOKCancel + vbQuestion, "警告")
            If str2$ = vbOK Then
            Unload FrmRenmd
            FrmRenadd.Show
            Else
            Unload FrmRenmd
            End If
       Unload Me
       Exit Sub
    Else
    mrc.MoveFirst
    Call viewData
    Frame2.Enabled = True
          CmdFirst.Enabled = True
          CmdPrevious.Enabled = True
          Cmdnext.Enabled = True
          CmdLast.Enabled = True
          txtbh.Enabled = True
          txtName.Enabled = False
          comsex.Enabled = False
          Comzhch.Enabled = False
          TxtZhw.Enabled = False
          Comxue.Enabled = False
          TxtJysh.Enabled = False
          TxtBorndate.Enabled = False
          Commian.Enabled = False
          Txtgongzuo.Enabled = False
          Txtyuanxi.Enabled = False
          Txtjianzhi.Enabled = False
          TxtJg.Enabled = False
          TxtShfzh.Enabled = False
          Frame1.Enabled = True
          Cmdedit.Enabled = True
          CmdDelete.Enabled = True
          CmdCancel.Enabled = False
          CmdUpdate.Enabled = False
          mcclean = True
          cmdtui.Enabled = True
          mcclean = True
    End If
End Sub
Private Sub Form_Load()
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrcc As ADODB.Recordset
    txtSQL = "select personnel_id from personnel_infor"
    Set mrcc = ExecuteSQL(txtSQL, MsgText)
    If Not mrcc.EOF Then
       mrcc.MoveFirst
    Do While Not mrcc.EOF
         txtbh.AddItem Trim(mrcc.Fields(0))
        '移动到下一条记录
        mrcc.MoveNext
    Loop
    End If
    mrcc.Close
   Call reflashform
End Sub