📄 frmsfmd.frm

📁 学院MIS管理系统,适合大部分毕业生,请大家支持
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00400000&
         Height          =   255
         Left            =   240
         TabIndex        =   9
         Top             =   1860
         Width           =   1095
      End
      Begin VB.Label Label10 
         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       =   &H00400000&
         Height          =   255
         Left            =   240
         TabIndex        =   8
         Top             =   3250
         Width           =   1095
      End
      Begin VB.Label Label11 
         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       =   &H00400000&
         Height          =   255
         Left            =   240
         TabIndex        =   7
         Top             =   2360
         Width           =   975
      End
      Begin VB.Label Label12 
         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       =   &H00400000&
         Height          =   255
         Left            =   240
         TabIndex        =   6
         Top             =   2800
         Width           =   975
      End
   End
   Begin VB.Label Label3 
      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       =   &H00000000&
      Height          =   255
      Left            =   360
      TabIndex        =   31
      Top             =   360
      Width           =   975
   End
End
Attribute VB_Name = "FrmSfmd"
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
Private Sub CmdCancel_Click()
 Call reflashform
 Call viewData
 Call intform
End Sub

Private Sub CmdDelete_Click()
   Dim txtSQLL As String
   Dim MsgTextt As String
   Dim mrcc As ADODB.Recordset
    Dim txtSQL As String
    Dim MsgText As String
    mrc.Close
    txtSQL = "select * from gongwenguanli where wenjian_id = '" & Trim(txtSID.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    '先按编号查询到人员信息，再删除
    If mrc.BOF Then
          MsgBox "数据库中没有此文件信息！", vbOKOnly + vbExclamation, "无法删除"
    Else
         Call viewData
          '提示是否删除
          str2$ = MsgBox("是否删除当前记录？", vbOKCancel, "删除当前记录")
        If str2$ = vbOK Then
          mrc.Delete
          MsgBox "删除成功！", vbOKOnly + vbExclamation, "警告"
        End If
    End If
      '数据库中如果没有信息，则询问添加
   txtSQL = "select * from gongwenguanli"
   Set mrcc = ExecuteSQL(txtSQL, MsgText)
     If mrcc.BOF Then
          str2$ = MsgBox("数据库中已经没有任何文件信息！" & Chr(13) & "          添加文件信息？", vbOKCancel, "警告")
            If str2$ = vbOK Then
            Unload FrmSfmd
            FrmSfadd.Show
            Exit Sub
            Else
            Unload FrmSfmd
            End If
     Else
     Call reflashform
     Call viewData
     Call intform
     End If
End Sub

Private Sub Cmdedit_Click()
Dim txtSQL As String
    Dim MsgText As String
    mrc.Close
    txtSQL = "select * from gongwenguanli where wenjian_id = '" & Trim(txtSID.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.BOF Then
          MsgBox "数据库中没有此文件信息！", vbOKOnly + vbExclamation, "无法修改"
          Call reflashform
          Call viewData
          Call intform
          Exit Sub
    Else
        Call viewData
    mcclean = False
   
   '使移动记录按钮失效
   Frame2.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(Index As Integer)
  mrc.MoveFirst
  Call viewData
  Call intform
  End Sub

Private Sub CmdLast_Click(Index As Integer)
 mrc.MoveLast
   Call viewData
   Call intform
  End Sub

Private Sub Cmdnext_Click(Index As Integer)
mrc.MoveNext
If mrc.EOF Then
mrc.MoveFirst
End If
 Call viewData
 Call intform
 End Sub

Private Sub CmdPrevious_Click(Index As Integer)
 mrc.MovePrevious
    If mrc.BOF Then
    mrc.MoveLast
    End If
    Call viewData
    Call intform
    End Sub

Public Sub accept()
Label1.Enabled = True
Label2.Enabled = True
Label3.Enabled = True
Label4.Enabled = False
Label5.Enabled = True
Label6.Enabled = True
Label7.Enabled = True
Label8.Enabled = True
Label9.Enabled = False
Label10.Enabled = False
Label11.Enabled = False
Label12.Enabled = True
Combolei.Enabled = True
txtSID.Enabled = True
txtName.Enabled = True
txtfenshu.Enabled = True
Combofawendw.Enabled = True
txtfadate.Enabled = False
Comboshouwendw.Enabled = False
txtshoudate.Enabled = True
txtqianshouren.Enabled = True
txtqianfaren.Enabled = False
txtqicaoren.Enabled = False
txtBeizhu.Enabled = True
End Sub
Public Sub send()
Label1.Enabled = True
Label2.Enabled = True
Label3.Enabled = True
Label4.Enabled = True
Label5.Enabled = False
Label6.Enabled = True
Label7.Enabled = False
Label8.Enabled = True
Label9.Enabled = True
Label10.Enabled = True
Label11.Enabled = True
Label12.Enabled = False
Combolei.Enabled = True
txtSID.Enabled = True
txtName.Enabled = True
txtfenshu.Enabled = True
Combofawendw.Enabled = False
txtfadate.Enabled = True
Comboshouwendw.Enabled = True
txtshoudate.Enabled = False
txtqianshouren.Enabled = False
txtqianfaren.Enabled = True
txtqicaoren.Enabled = True
txtBeizhu.Enabled = True

End Sub
'刷新窗口，给 mrc 赋值
Public Sub reflashform()
   Dim txtSQL As String
   Dim MsgText As String
   txtSQL = "select * from gongwenguanli"
   Set mrc = ExecuteSQL(txtSQL, MsgText)
   If Not mrc.EOF Then
   mrc.MoveFirst
   End If
 End Sub
 '初始化窗体，使文本框无效
 Public Sub intform()
          Frame2.Enabled = True
          Combolei.Enabled = False
          txtSID.Enabled = True
          txtName.Enabled = False
          txtfenshu.Enabled = False
          Combofawendw.Enabled = False
          txtfadate.Enabled = False
          Comboshouwendw.Enabled = False
          txtshoudate.Enabled = False
          txtqianshouren.Enabled = False
          txtqianfaren.Enabled = False
          txtqicaoren.Enabled = False
          txtBeizhu.Enabled = False
          Cmdedit.Enabled = True
          CmdDelete.Enabled = True
          CmdCancel.Enabled = False
          CmdUpdate.Enabled = False
          mcclean = True
          cmdtui.Enabled = True
          mcclean = True
      
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(Combolei.Text) Then
        MsgBox "请输入文件的收发属性！", vbOKOnly + vbExclamation, "警告"
      Combolei.SetFocus
      Exit Sub
     End If
   '判断是否输入编号
     If Not Testtxt(txtSID.Text) Then
        MsgBox "请输入编号！", vbOKOnly + vbExclamation, "警告"
      txtSID.SetFocus
      Exit Sub
     End If
   
     '判断是否输入发送日期？
      If Testtxt(txtfadate.Text) Then
       '判断输入的发送日期是否按照格式
             If Not IsDate(txtfadate.Text) Then
               MsgBox "发送日期应输入日期格式（yyyy-mm-dd）！", vbOKOnly + vbExclamation, "警告"
               txtfadate.SetFocus
                 Exit Sub
             Else
                 txtfadate = Format(txtfadate, "yyyy-mm-dd")
             End If
      Else
         txtfadate.Text = "1900-01-01"
         txtfadate = Format(txtfadate, "yyyy-mm-dd")
      End If
      '判断输入的收文日期是否按照格式
        If Testtxt(txtshoudate.Text) Then
             If Not IsDate(txtshoudate.Text) Then
               MsgBox "收文时间应输入日期格式（yyyy—mm—dd）！", vbOKOnly + vbExclamation, "警告"
               txtshoudate.SetFocus
                 Exit Sub
             Else
             txtshoudate = Format(txtshoudate, "yyyy-mm-dd")
             End If
        Else
         txtshoudate.Text = "1900-01-01"
        txtshoudate = Format(txtshoudate, "yyyy-mm-dd")
        End If
     '判断文件编号是否重复
    txtSQL = "select * from gongwenguanli where wenjian_id = '" & Trim(txtSID.Text) & "'"
    Set mrcc = ExecuteSQL(txtSQL, MsgText)
    If mrcc.EOF = False Then
        If mrcc.Fields(0) = mrc.Fields(0) Then
        Else
        MsgBox "文件编号重复，请重新输入！", vbOKOnly + vbExclamation, "警告"
        mrcc.Close
        txtSID.SetFocus
        Exit Sub
        End If
    End If
   
       mrcc.Close
       mrc.Delete
       mrc.AddNew
      If Trim(Combolei.Text) = "收文" Then
       mrc.Fields(0) = Trim(txtSID.Text)
       mrc.Fields(1) = Trim(Combolei.Text)
       mrc.Fields(2) = Trim(txtName.Text)
       mrc.Fields(3) = Trim(Combofawendw.Text)
       mrc.Fields(4) = Trim(txtshoudate.Text)
       mrc.Fields(5) = Trim(txtfenshu.Text)
       mrc.Fields(6) = Trim(txtqianshouren.Text)
       mrc.Fields(8) = Trim(txtBeizhu.Text)
       End If
       
       If Trim(Combolei.Text) = "发文" Then
       mrc.Fields(0) = Trim(txtSID.Text)
       mrc.Fields(1) = Trim(Combolei.Text)
       mrc.Fields(2) = Trim(txtName.Text)
       mrc.Fields(3) = Trim(Comboshouwendw.Text)
       mrc.Fields(4) = Trim(txtfadate.Text)
       mrc.Fields(5) = Trim(txtfenshu.Text)
       mrc.Fields(6) = Trim(txtqicaoren.Text)
       mrc.Fields(7) = Trim(txtqianfaren.Text)
       mrc.Fields(8) = Trim(txtBeizhu.Text)
       End If
       mrc.Update
          MsgBox "修改文件信息成功！", vbOKOnly + vbExclamation, "修改文件信息"
          Call reflashform
          Call viewData
          Call intform
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
         txtqianfaren.AddItem Trim(mrcc.Fields(1))
         txtqianshouren.AddItem Trim(mrcc.Fields(1))
         txtqicaoren.AddItem Trim(mrcc.Fields(1))
        '移动到下一条记录
        mrcc.MoveNext
    Loop
    End If
    mrcc.Close
    '将现有的文件编号在编号下拉列表中列出来
    txtSQL = "select wenjian_id from gongwenguanli"
    Set mrcc = ExecuteSQL(txtSQL, MsgText)
    If Not mrcc.EOF Then
       mrcc.MoveFirst
    Do While Not mrcc.EOF
         txtSID.AddItem Trim(mrcc.Fields(0))
        '移动到下一条记录
        mrcc.MoveNext
    Loop
    End If
    mrcc.Close
   '给 mrc 赋值
   Call reflashform
   Call viewData
   '初始化窗体
   Call intform
End Sub
'在对话框中显示数据库中信息
Public Sub viewData()
     Combolei.Text = Trim(mrc.Fields(1))
     txtSID.Text = Trim(mrc.Fields(0))
     txtName.Text = Trim(mrc.Fields(2))
     txtfenshu.Text = Trim(mrc.Fields(5))
            If Trim(Combolei.Text) = "收文" Then
             Call accept
             Combofawendw.Text = Trim(mrc.Fields(3))
             txtshoudate.Text = Trim(mrc.Fields(4))
             txtqianshouren.Text = Trim(mrc.Fields(6))
             txtBeizhu.Text = Trim(mrc.Fields(8))
            End If
            
            If Trim(Combolei.Text) = "发文" Then
               Call send
               Comboshouwendw.Text = Trim(mrc.Fields(3))
               txtfadate.Text = Trim(mrc.Fields(4))
               txtqicaoren.Text = Trim(mrc.Fields(6))
               txtqianfaren.Text = Trim(mrc.Fields(7))
               txtBeizhu.Text = Trim(mrc.Fields(8))
           End If
End Sub
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -