⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmsfadd.frm

📁 这是一个有VB开发的学院办公自动化系统
💻 FRM
📖 第 1 页 / 共 2 页
字号:
         EndProperty
         ForeColor       =   &H00000000&
         Height          =   255
         Left            =   120
         TabIndex        =   8
         Top             =   240
         Width           =   855
      End
      Begin VB.Label Label2 
         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            =   120
         TabIndex        =   7
         Top             =   720
         Width           =   975
      End
      Begin VB.Label Label6 
         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            =   2760
         TabIndex        =   6
         Top             =   255
         Width           =   1095
      End
      Begin VB.Label Label8 
         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            =   120
         TabIndex        =   5
         Top             =   1200
         Width           =   1095
      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            =   200
      TabIndex        =   14
      Top             =   120
      Width           =   975
   End
End
Attribute VB_Name = "FrmSfadd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdCalendar_Click()
    Dim UserDate As Date
    UserDate = CVDate(txtfadate)
    If FrmCalfa.GetDate(UserDate) Then
    txtfadate = UserDate
    End If
End Sub

Private Sub cmdtui_Click()
Unload Me
End Sub

'由文件的收发属性决定应添的项目
Private Sub Combolei_Click()
If Trim(Combolei.Text) = "收文" Then
Frame1.Enabled = True
Frame2.Enabled = True
Frame3.Enabled = False
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
cmdcalendar.Enabled = False
Comboshouwendw.Enabled = False
txtshoudate.Enabled = True
Command1.Enabled = True
txtqianshouren.Enabled = True
txtqianfaren.Enabled = False
txtqicaoren.Enabled = False
txtBeizhu.Enabled = True
Comok.Enabled = True
Comnot.Enabled = True
End If
If Trim(Combolei.Text) = "发文" Then
Frame1.Enabled = True
Frame2.Enabled = False
Frame3.Enabled = True
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
cmdcalendar.Enabled = True
Comboshouwendw.Enabled = True
txtshoudate.Enabled = False
Command1.Enabled = False
txtqianshouren.Enabled = False
txtqianfaren.Enabled = True
txtqicaoren.Enabled = True
txtBeizhu.Enabled = True
Comok.Enabled = True
Comnot.Enabled = True
End If
End Sub

Private Sub Command1_Click()
    Dim UserDate As Date
    UserDate = CVDate(txtshoudate)
    If FrmCalshou.GetDate(UserDate) Then
        txtshoudate = UserDate
    End If

End Sub

Private Sub Comok_Click()
 '定义数据集对象
  Dim mrc As ADODB.Recordset
  '定义字符串变量,表示查询语句
  Dim txtSQL As String
  '定义字符串变量,返回查询信息
  Dim MsgText As String
  '判断是否输入编号,编号是主键,不能为空
  If Trim(Combolei.Text) <> "收文" And Trim(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
'判断是否有重复的记录
    txtSQL = "select * from gongwenguanli where wenjian_id = '" & Trim(txtSID.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF = False Then
       MsgBox "文件编号重复!请重新输入", vbOKOnly + vbExclamation, "警告"
       mrc.Close
       txtSID.SetFocus
    Else
       mrc.Close
       '判断是否输入发文日期?
      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"
       '执行查询操作
       Set mrc = ExecuteSQL(txtSQL, MsgText)
       '添加记录
       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, "警告"
       '关闭数据集对象
       mrc.Close
        '添加成功后,将文本框置空,防止连续添加出现粘带现象
        Call reflash
    End If
End Sub

Private Sub Comnot_Click()
Call reflash
Call intform
End Sub
Public Sub reflash()
        Combolei.Text = ""
        txtSID.Text = ""
        txtName.Text = ""
        txtfenshu.Text = ""
        Combofawendw.Text = ""
        txtfadate.Text = Date
        Comboshouwendw.Text = ""
        txtshoudate.Text = Date
        txtqianshouren.Text = ""
        txtqianfaren.Text = ""
        txtqicaoren.Text = ""
        txtBeizhu.Text = ""
End Sub
Public Sub intform()
Frame1.Enabled = False
Frame2.Enabled = False
Frame3.Enabled = False
Label1.Enabled = False
Label2.Enabled = False
Label3.Enabled = True
Label4.Enabled = False
Label5.Enabled = False
Label6.Enabled = False
Label7.Enabled = False
Label8.Enabled = False
Label9.Enabled = False
Label10.Enabled = False
Label11.Enabled = False
Label12.Enabled = False
Combolei.Enabled = True
txtSID.Enabled = False
txtName.Enabled = False
txtfenshu.Enabled = False
Combofawendw.Enabled = False
txtfadate.Enabled = False
cmdcalendar.Enabled = False
Comboshouwendw.Enabled = False
txtshoudate.Enabled = False
Command1.Enabled = False
txtqianshouren.Enabled = False
txtqianfaren.Enabled = False
txtqicaoren.Enabled = False
txtBeizhu.Enabled = False
Comok.Enabled = False
Comnot.Enabled = False
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
Call reflash
Call intform
End Sub

⌨️ 快捷键说明

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