📄 frmsfadd.frm
字号:
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 + -