frmwormd.frm

这是一个有VB开发的学院办公自动化系统

      BackColor       =   &H8000000D&
      Caption         =   "修改信息"
      ForeColor       =   &H0080FFFF&
      Height          =   3650
      Index           =   0
      Left            =   4440
      TabIndex        =   0
      Top             =   360
      Width           =   1935
      Begin VB.CommandButton cmdtui 
         Caption         =   "退    出"
         Height          =   375
         Left            =   380
         TabIndex        =   10
         Top             =   3000
         Width           =   1215
      End
      Begin VB.CommandButton CmdDelete 
         Caption         =   "删除记录"
         Height          =   375
         Left            =   360
         TabIndex        =   9
         Top             =   2300
         Width           =   1215
      End
      Begin VB.CommandButton CmdCancel 
         Caption         =   "取消修改"
         Height          =   375
         Left            =   360
         TabIndex        =   8
         Top             =   1650
         Width           =   1215
      End
      Begin VB.CommandButton CmdUpdate 
         Caption         =   "确定修改"
         Height          =   375
         Left            =   360
         TabIndex        =   7
         Top             =   1000
         Width           =   1215
      End
      Begin VB.CommandButton CmdEdit 
         Caption         =   "修改信息"
         Default         =   -1  'True
         Height          =   375
         Left            =   380
         TabIndex        =   6
         Top             =   360
         Width           =   1215
      End
   End
End
Attribute VB_Name = "FrmWormd"
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))
     txtkech.Text = Trim(mrc.Fields(2))
     txtbanji.Text = Trim(mrc.Fields(3))
     txtrenshu.Text = Trim(mrc.Fields(4))
     Comxue.Text = Trim(mrc.Fields(5))
     Comqi.Text = Trim(mrc.Fields(6))
     renshu.Text = Trim(mrc.Fields(7))
End Sub

Private Sub CmdCancel_Click()
  '判断是否处于修改状态
  If mcclean = False Then
     Call reflashform
   End If
   
End Sub
Private Sub CmdDelete_Click()
    Dim txtSQL As String
    Dim MsgText As String
    mrc.Close
    txtSQL = "select * from gongzuoliang 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 gongzuoliang where Personnel_id = '" & Trim(txtbh.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.BOF Then
          str2$ = MsgBox("没有此教师工作量记录！" & Chr(13) & " 添加其工作量信息？", vbOKCancel + vbQuestion, "无法修改")
          If str2$ = vbOK Then
          FrmWoradd.Show
          End If
          Unload Me
          Exit Sub
    Else
        Call viewData
    
    mcclean = False
   '使移动记录按钮失效
    CmdFirst.Enabled = False
    CmdPrevious.Enabled = True
    Cmdnext.Enabled = True
    CmdLast.Enabled = False
    '是各个文本框有效
          txtbh.Enabled = True
          txtName.Enabled = True
          txtkech.Enabled = True
          txtbanji.Enabled = True
          txtrenshu.Enabled = True
          Comxue.Enabled = True
          Comqi.Enabled = True
          renshu.Enabled = True
          Cmdedit.Enabled = False
          CmdDelete.Enabled = True
          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 Not Testtxt(txtName.Text) Then
        MsgBox "请输入教师名称！", vbOKOnly + vbExclamation, "警告"
      txtName.SetFocus
      Exit Sub
    End If
    If Testtxt(txtrenshu.Text) Then
        If Not IsNumeric(Trim(txtrenshu.Text)) Then
        MsgBox "课时请输入数字！", vbOKOnly + vbExclamation, "警告"
        txtrenshu.SetFocus
        Exit Sub
        End If
  End If
    '从人员表中查询是否有此教师，如果有，判断姓名是否相符
    txtSQL = "select * from Personnel_infor where Personnel_id = '" & Trim(txtbh.Text) & "'"
    Set mrcc = ExecuteSQL(txtSQL, MsgText)
    If mrcc.EOF = True Then
        MsgBox "教师编号错误，请重新输入！", vbOKOnly + vbExclamation, "警告"
        txtbh.SetFocus
        Exit Sub
    End If
    
    If mrcc.EOF = False Then
        '判断编号与姓名是否相符
        If Trim(mrcc.Fields(1)) <> Trim(txtName.Text) Then
        MsgBox "教师编号与教师姓名不符！", vbOKOnly + vbExclamation, "警告"
        txtbh.SetFocus
        Exit Sub
        Else
        mrcc.Close
        '判断教师工作量表中是否有重复记录
        txtSQL = "select * from gongzuoliang where Personnel_id = '" & Trim(txtbh.Text) & "'"
        Set mrcc = ExecuteSQL(txtSQL, MsgText)
          If mrcc.EOF = True Then
             mrcc.Close
          Else
             mrcc.MoveFirst
             Do While Not mrcc.EOF
             If Trim(mrcc.Fields(0)) = Trim(txtbh.Text) And Trim(mrcc.Fields(6)) = Trim(Comqi.Text) _
              And Trim(mrcc.Fields(2)) = Trim(txtkech.Text) And Trim(mrcc.Fields(3)) = Trim(txtbanji.Text) _
              And Trim(mrcc.Fields(5)) = Trim(Comxue.Text) And Trim(mrcc.Fields(4)) = Trim(txtrenshu.Text) Then
              MsgBox "教师工作量信息重复！", vbOKOnly + vbExclamation, "警告"
              mrcc.Close
              Exit Sub
              End If
              mrcc.MoveNext
              Loop
             
             
           End If
    End If
    End If
       
       '用先删除，再添加的办法代表更新
       mrc.Delete
       mrc.AddNew
       mrc.Fields(0) = Trim(txtbh.Text)
       mrc.Fields(1) = Trim(txtName.Text)
       mrc.Fields(2) = Trim(txtkech.Text)
       mrc.Fields(3) = Trim(txtbanji.Text)
       mrc.Fields(4) = Trim(txtrenshu.Text)
       mrc.Fields(5) = Trim(Comxue.Text)
       mrc.Fields(6) = Trim(Comqi.Text)
       mrc.Fields(7) = Trim(renshu.Text)
       mrc.Update
          MsgBox "修改工作量信息成功！", vbOKOnly + vbExclamation, "修改信息"
         Call viewData
         Call reflashform
        
End Sub
'用于刷新窗体
Public Sub reflashform()
   Dim txtSQL As String
   Dim MsgText As String
   txtSQL = "select * from gongzuoliang "
   Set mrc = ExecuteSQL(txtSQL, MsgText)
      If mrc.BOF = True Then
            str2$ = MsgBox("工作量信息已经被清空！" & Chr(13) & "          添加工作量信息？", vbOKCancel + vbQuestion, "警告")
            If str2$ = vbOK Then
            Unload FrmWormd
            FrmWoradd.Show
            Else
            Unload FrmWormd
            End If
       Unload Me
       Exit Sub
      Else
        mrc.MoveFirst
        Call viewData
          CmdFirst.Enabled = True
          CmdPrevious.Enabled = True
          Cmdnext.Enabled = True
          CmdLast.Enabled = True
          txtbh.Enabled = True
          txtName.Enabled = False
          txtkech.Enabled = False
          txtbanji.Enabled = False
          txtrenshu.Enabled = False
          renshu.Enabled = False
          Comqi.Enabled = False
          Comxue.Enabled = False
          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,name 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))
         txtName.AddItem Trim(mrcc.Fields(1))
         '移动到下一条记录
        mrcc.MoveNext
    Loop
    End If
    mrcc.Close
    Call reflashform
End Sub