📄 exportcur.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form ExportCur
Caption = "导出报销记录"
ClientHeight = 5550
ClientLeft = 60
ClientTop = 450
ClientWidth = 7830
LinkTopic = "Form1"
ScaleHeight = 5550
ScaleWidth = 7830
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame1
Caption = "导出条件【忽略的字段留空】"
Height = 5295
Left = 120
TabIndex = 0
Top = 120
Width = 7575
Begin MSComDlg.CommonDialog CommDlg
Left = 2520
Top = 2400
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CheckBox Check1
Caption = "不限定日期"
Height = 255
Left = 5160
TabIndex = 17
Top = 1200
Width = 2055
End
Begin VB.CommandButton Command2
Caption = "退出"
Height = 495
Left = 4080
TabIndex = 15
Top = 4560
Width = 3135
End
Begin VB.CommandButton Command1
Caption = "导出"
Height = 495
Left = 360
TabIndex = 14
Top = 4560
Width = 3135
End
Begin VB.ComboBox Combo2
Height = 300
Left = 240
TabIndex = 13
Text = "Combo2"
Top = 1800
Width = 2175
End
Begin VB.TextBox Text4
Height = 1935
Left = 240
MultiLine = -1 'True
TabIndex = 6
Text = "ExportCur.frx":0000
Top = 2400
Width = 7095
End
Begin VB.ComboBox Combo1
Height = 300
Left = 2760
TabIndex = 5
Text = "Combo1"
Top = 600
Width = 2175
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 255
Left = 2760
TabIndex = 4
Top = 1200
Width = 2175
_ExtentX = 3836
_ExtentY = 450
_Version = 393216
Format = 65667073
CurrentDate = 38012
End
Begin VB.TextBox Text3
Height = 270
Left = 240
TabIndex = 3
Text = "Text3"
Top = 1200
Width = 2175
End
Begin VB.TextBox Text2
Height = 270
Left = 5160
TabIndex = 2
Text = "Text2"
Top = 600
Width = 2175
End
Begin VB.TextBox Text1
Height = 270
Left = 240
TabIndex = 1
Text = "Text1"
Top = 600
Width = 2175
End
Begin VB.Label Label7
Caption = "报销说明"
Height = 255
Left = 240
TabIndex = 16
Top = 2160
Width = 1815
End
Begin VB.Label Label6
Caption = "报销部门"
Height = 255
Left = 240
TabIndex = 12
Top = 1560
Width = 1815
End
Begin VB.Label Label5
Caption = "报销人ID编号"
Height = 255
Left = 240
TabIndex = 11
Top = 960
Width = 1815
End
Begin VB.Label Label4
Caption = "报销日期"
Height = 255
Left = 2760
TabIndex = 10
Top = 960
Width = 1815
End
Begin VB.Label Label3
Caption = "报销金额"
Height = 255
Left = 5160
TabIndex = 9
Top = 360
Width = 1815
End
Begin VB.Label Label2
Caption = "报销类别"
Height = 255
Left = 2760
TabIndex = 8
Top = 360
Width = 1815
End
Begin VB.Label Label1
Caption = "报销单号"
Height = 255
Left = 240
TabIndex = 7
Top = 360
Width = 1815
End
End
End
Attribute VB_Name = "ExportCur"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Check1_Click()
If Check1.Value Then '设置是否可以将时间作为搜索条件
DTPicker1.Enabled = False
Else
DTPicker1.Enabled = True
End If
End Sub
Private Sub Command1_Click()
Dim sql As String
Dim rs As New ADODB.Recordset
Dim FilterEmpty As Boolean '搜索条件是否已经设置
Dim rsFilter As String 'SQL语句搜索条件
Dim i As Integer
Dim resultcount As Long '记录数
If (Not IsNumeric(Text2.Text)) And (Text2.Text <> "") Then '输入有效性检查
MsgBox "报销金额必须是数字！", vbCritical
Text2.SetFocus
Exit Sub
End If
If DbHandle.DbConnection Then
FilterEmpty = True '设置此时搜索条件还没有设置
If Text1.Text <> "" Then '如果报销单号设置成为搜索条件,则增加一SQL判断语句,组合rsFilter字串
If FilterEmpty Then
rsFilter = "CUR_ID='" & Text1.Text & "'"
Else
rsFilter = rsFilter & " AND CUR_ID='" & Text1.Text & "'"
End If
FilterEmpty = False
End If
If Text2.Text <> "" Then '如果报销金额设置成为搜索条件,则增加一SQL判断语句,组合rsFilter字串
If FilterEmpty Then
rsFilter = "CUR_MONEY=" & Val(Text2.Text)
Else
rsFilter = rsFilter & " AND CUR_MONEY=" & Val(Text2.Text)
End If
FilterEmpty = False
End If
If Text3.Text <> "" Then '如果职工ID设置成为搜索条件,则增加一SQL判断语句,组合rsFilter字串
If FilterEmpty Then
rsFilter = "CUR_USER='" & Text3.Text & "'"
Else
rsFilter = rsFilter & " AND CUR_USER='" & Text3.Text & "'"
End If
FilterEmpty = False
End If
If Text4.Text <> "" Then '如果报销说明设置成为搜索条件,则增加一SQL判断语句,组合rsFilter字串
If FilterEmpty Then
rsFilter = "CUR_REMARK='" & Text4.Text & "'"
Else
rsFilter = rsFilter & " AND CUR_REMARK='" & Text4.Text & "'"
End If
FilterEmpty = False
End If
If DTPicker1.Enabled Then '如果报销日期设置成为搜索条件,则增加一SQL判断语句,组合rsFilter字串
If FilterEmpty Then
rsFilter = "CUR_DATE='" & DTPicker1.Value & "'"
Else
rsFilter = rsFilter & " AND CUR_DATE='" & DTPicker1.Value & "'"
End If
FilterEmpty = False
End If
If Combo1.ListIndex <> -1 Then '如果报销类别设置成为搜索条件,则增加一SQL判断语句,组合rsFilter字串
If FilterEmpty Then
rsFilter = "CUR_TYPE=" & Combo1.ListIndex
Else
rsFilter = rsFilter & " AND CUR_TYPE=" & Combo1.ListIndex
End If
FilterEmpty = False
End If
If Combo2.ListIndex <> -1 Then '如果报销部门设置成为搜索条件,则增加一SQL判断语句,组合rsFilter字串
If FilterEmpty Then
rsFilter = "CUR_PART=" & Combo2.ListIndex
Else
rsFilter = rsFilter & " AND CUR_PART=" & Combo2.ListIndex
End If
FilterEmpty = False
End If
'组合整体SQL语句,查找符合条件的报销记录
sql = "SELECT CUR_ID,CUR_MONEY,CUR_USER,CUR_DATE,CUR_REMARK,PART_NAME,CURTYPE_NAME FROM TBL_CUR,TBL_PART,TBL_CURTYPE WHERE "
If FilterEmpty Then
sql = sql & "CUR_PART=PART_ID AND CUR_TYPE=CURTYPE_ID"
Else
sql = sql & rsFilter & " AND CUR_PART=PART_ID AND CUR_TYPE=CURTYPE_ID"
End If
rs.CursorType = adOpenDynamic
rs.LockType = adLockOptimistic
rs.Open sql, DbFinance
resultcount = DbHandle.resultcount(rs)
CommDlg.Flags = cdlOFNOverwritePrompt '设置保存对话框覆盖提示属性
CommDlg.Filter = "文本文件|*.txt" '设置保存对话框显示文件类型属性
CommDlg.ShowSave
If CommDlg.FileName <> "" Then '如果保存文件名被设置就循环读取结果集,写进文件中
Open CommDlg.FileName For Output As #1
Print #1, "报销单号"; Tab; "报销类别"; Tab; "报销金额"; Tab; "报销人ID"; Tab; "报销日期"; Tab; "报销部门"; Tab; "报销说明"
For i = 1 To resultcount
Print #1, rs("CUR_ID"); Tab; rs("CURTYPE_NAME"); Tab; Str(rs("CUR_MONEY")); Tab; rs("CUR_USER"); Tab; rs("CUR_DATE"); Tab; rs("PART_NAME"); Tab; rs("CUR_REMARK")
rs.MoveNext
Next i
Close #1
End If
rs.Close '释放结果集,关闭数据库连接
DbHandle.DbClose
Else '数据库连接出错,退出
MsgBox "数据库错误！", vbExclamation
DbHandle.DbClose
End
End If
End Sub
Private Sub Command2_Click()
Unload Me '返回主窗体
End Sub
Private Sub Form_Load()
Dim sql As String
Dim rs As New ADODB.Recordset
Me.Left = (Screen.Width - Me.ScaleWidth) / 2 '窗体居中显示
Me.Top = (Screen.Height - Me.ScaleHeight) / 2
If DbHandle.DbConnection Then
sql = "TBL_CURTYPE" '提取报销类别记录
rs.CursorType = adOpenDynamic
rs.LockType = adLockOptimistic
rs.Filter = ""
rs.Open sql, DbFinance
Do While rs.EOF = False '循环加入下拉列表中
Combo1.AddItem (rs("CURTYPE_NAME"))
Combo1.ItemData(Combo1.NewIndex) = rs("CURTYPE_ID")
rs.MoveNext
Loop
rs.Close '关闭结果集和数据库连接
Set rs = Nothing
DbHandle.DbClose
Else '数据库连接失败,退出
MsgBox "数据库错误！", vbExclamation
DbHandle.DbClose
End
End If
If DbHandle.DbConnection Then
sql = "TBL_PART" '提取报销部门记录
rs.CursorType = adOpenDynamic
rs.LockType = adLockOptimistic
rs.Filter = ""
rs.Open sql, DbFinance
Do While rs.EOF = False '循环加入下拉列表中
Combo2.AddItem (rs("PART_NAME"))
Combo2.ItemData(Combo2.NewIndex) = rs("PART_ID")
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
DbHandle.DbClose
Else '数据库连接失败,退出
MsgBox "数据库错误！", vbExclamation
DbHandle.DbClose
End
End If
Text1.Text = "" '窗体元素初始化属性设置
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text4.MaxLength = 100
Combo1.Text = ""
Combo2.Text = ""
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -