📄 frmmain.frm
字号:
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 11160
TabIndex = 22
Top = 405
Width = 1455
End
Begin VB.Label Label9
BackStyle = 0 'Transparent
Caption = "资金科目"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6000
TabIndex = 21
Top = 1125
Width = 1095
End
Begin VB.Label Label10
BackStyle = 0 'Transparent
Caption = "所属单位代码"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 8760
TabIndex = 20
Top = 1125
Width = 1095
End
Begin VB.Label Labsearch
Caption = "票据号码"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Index = 0
Left = 360
TabIndex = 7
Top = 360
Width = 975
End
Begin VB.Label Labsearch
Caption = "起始时间"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808000&
Height = 375
Index = 6
Left = 3480
TabIndex = 6
Top = 1680
Width = 855
End
Begin VB.Label Labsearch
Caption = "截止时间"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808000&
Height = 375
Index = 7
Left = 6000
TabIndex = 5
Top = 1680
Width = 855
End
Begin VB.Label Labsearch
Caption = "资金发生时间："
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C000C0&
Height = 375
Index = 5
Left = 1440
TabIndex = 4
Top = 1680
Width = 1455
End
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 360
Top = 7440
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Label Labeljl
BackStyle = 0 'Transparent
Caption = "本次查询共有0条记录"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 375
Left = 9480
TabIndex = 28
Top = 2760
Width = 4455
End
Begin VB.Menu menukj
Caption = "资金项目管理"
NegotiatePosition= 2 'Middle
Begin VB.Menu submenukjadd
Caption = "增加新资金项目"
End
Begin VB.Menu submenukjmodi
Caption = "修改资金项目"
End
Begin VB.Menu submenukjserch
Caption = "查询资金项目"
End
Begin VB.Menu submenukjdel
Caption = "删除资金项目"
End
End
Begin VB.Menu menudbf
Caption = "数据库维护"
Begin VB.Menu submenudbfcj
Caption = "创建新数据库"
End
Begin VB.Menu submenudbfsz
Caption = "选择数据库"
End
Begin VB.Menu submenudbfbf
Caption = "备份数据"
End
Begin VB.Menu submenudbfhf
Caption = "恢复数据"
End
End
Begin VB.Menu menuassist
Caption = "辅助项目"
Begin VB.Menu submenupzlb
Caption = "资金类别名称"
End
Begin VB.Menu submenufzkmlb
Caption = "资金科目类别信息"
End
Begin VB.Menu submenufzkm
Caption = "资金科目信息"
End
Begin VB.Menu submenufzgsbm
Caption = "资金所属单位信息"
End
Begin VB.Menu submenufzglbm
Caption = "资金归口管理单位信息"
End
End
Begin VB.Menu menuhistory
Caption = "历史记录查询"
End
Begin VB.Menu menuuser
Caption = "系统用户管理"
End
Begin VB.Menu menuquit
Caption = "退出"
End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim conn As New ADODB.Connection
Dim rskjyw As New ADODB.Recordset
Dim rspzlb As New ADODB.Recordset
Dim rsgkglbm As New ADODB.Recordset
Dim rsyskmlb As New ADODB.Recordset
Dim rsyskm As New ADODB.Recordset
Dim rsfygsbm As New ADODB.Recordset
Dim rs As New ADODB.Recordset
Dim addrecord As Boolean
Private Sub adorefresh()
Dim fieldname(14) As Variant
Dim wide(14) As Variant
Dim str As String
fieldname(0) = "序号"
fieldname(1) = "票据号码"
fieldname(2) = "票据类别名称"
fieldname(3) = "发生日期"
fieldname(4) = "归口管理部门代码"
fieldname(5) = "归口管理部门"
fieldname(6) = "资金科目类别代码"
fieldname(7) = "资金科目类别"
fieldname(8) = "资金科目代码"
fieldname(9) = "资金科目名称"
fieldname(10) = "费用归属部门代码"
fieldname(11) = "费用归属部门"
fieldname(12) = "业务金额"
fieldname(13) = "备注"
wide(0) = 400
wide(1) = 1000
wide(2) = 1000
wide(3) = 1000
wide(4) = 1000
wide(5) = 1400
wide(6) = 1000
wide(7) = 1400
wide(8) = 1000
wide(9) = 1400
wide(10) = 1000
wide(11) = 1400
wide(12) = 1400
wide(13) = 2000
'str = "Provider=SQLOLEDB.1;Password=sa;Persist Security Info=True;User ID=sa;Initial Catalog=ysgl2004;Data Source=(local)"
If conn.State <> 1 Then
conn.CursorLocation = adUseClient
conn.Open nowconnectstring
End If
str = "SELECT a.xuhao, a.pzhm,a.pzlbmc, a.fsrq , e.dm as glbmdm,a.glbmmc,b.dm AS yskmlbdm, a.yslbmc, c.dm AS yskmdm,a.yskmmc, d.dm AS gsbmdm, a.gsbmmc, a.ywje, a.bz FROM kjyw a INNER JOIN yskmlb b ON a.yslbmc = b.yslbmc INNER JOIN yskm c ON a.yskmmc = c.yskmmc INNER JOIN fygsbm d ON a.gsbmmc = d.gsbmmc INNER JOIN gkglbm e ON a.glbmmc = e.glbmmc ORDER BY a.pzhm"
If rskjyw.State <> 1 Then
rskjyw.Open str, conn, adOpenStatic, adLockBatchOptimistic
Else
rskjyw.Requery
End If
If rsyskm.State <> 1 Then
rsyskm.Open "select * from yskm order by dm", conn, adOpenStatic, adLockBatchOptimistic
Else
rsyskm.Requery
End If
If rsyskmlb.State <> 1 Then
rsyskmlb.Open "select * from yskmlb order by dm", conn, adOpenStatic, adLockBatchOptimistic
Else
rsyskmlb.Requery
End If
If rspzlb.State <> 1 Then
rspzlb.Open "select * from pzlb ", conn, adOpenStatic, adLockBatchOptimistic
Else
rspzlb.Requery
End If
If rsfygsbm.State <> 1 Then
rsfygsbm.Open "select * from fygsbm order by dm", conn, adOpenStatic, adLockBatchOptimistic
Else
rsfygsbm.Requery
End If
If rsgkglbm.State <> 1 Then
rsgkglbm.Open "select * from gkglbm order by dm", conn, adOpenStatic, adLockBatchOptimistic
Else
rsgkglbm.Requery
End If
Set DataGrid1.DataSource = rskjyw
For i = 0 To 12
DataGrid1.Columns(i).Caption = fieldname(i)
DataGrid1.Columns(i).Width = wide(i)
DataGrid1.Columns(i).DataField = rskjyw.Fields(i).Name
Next i
Set Dacompzhm.RowSource = rskjyw
Dacompzhm.ListField = rskjyw.Fields("pzhm").Name
Set Dacompzlbmc.RowSource = rspzlb
Dacompzlbmc.ListField = rskjyw.Fields("pzlbmc").Name
Set Dacomglbmdm.RowSource = rsgkglbm
Dacomglbmdm.ListField = rsgkglbm.Fields("dm").Name
Set Dacomglbmmc.RowSource = rsgkglbm
Dacomglbmmc.ListField = rsgkglbm.Fields("glbmmc").Name
Set Dacomyslbdm.RowSource = rsyskmlb
Dacomyslbdm.ListField = rsyskmlb.Fields("dm").Name
Set Dacomyslbmc.RowSource = rsyskmlb
Dacomyslbmc.ListField = rsyskmlb.Fields("yslbmc").Name
Set Dacomyskmdm.RowSource = rsyskm
Dacomyskmdm.ListField = rsyskm.Fields("dm").Name
Set Dacomyskmmc.RowSource = rsyskm
Dacomyskmmc.ListField = rsyskm.Fields("yskmmc").Name
Set Dacomgsbmdm.RowSource = rsfygsbm
Dacomgsbmdm.ListField = rsfygsbm.Fields("dm").Name
Set Dacomgsbmmc.RowSource = rsfygsbm
Dacomgsbmmc.ListField = rsfygsbm.Fields("gsbmmc").Name
DTPicker2.Value = Date
End Sub
Private Sub rsrefresh()
rskjyw.Requery
rspzlb.Requery
rsyskm.Requery
rsyskmlb.Requery
rsfygsbm.Requery
rsgkglbm.Requery
End Sub
Private Sub cmdsearch_Click(Index As Integer)
Dim str As Variant
Dim str1 As Variant
Select Case Index
Case 0 '查询
If Dacompzhm.Text <> "" Then
str = "pzhm like '%" & Dacompzhm.Text & "%'"
End If
If Dacompzlbmc.Text <> "" Then
If str = "" Then
str = "pzlbmc like '%" & Dacompzlbmc.Text & "%'"
Else
str = str & " and pzlbmc like '%" & Dacompzlbmc.Text & "%'"
End If
End If
If Dacomglbmmc.Text <> "" Then
If str = "" Then
str = "glbmmc like '" & Dacomglbmmc.Text & "'"
Else
str = str & " and glbmmc like '" & Dacomglbmmc.Text & "'"
End If
End If
If Dacomyslbmc.Text <> "" Then
If str = "" Then
str = "yslbmc like '" & Dacomyslbmc.Text & "'"
Else
str = str & " and yslbmc like '" & Dacomyslbmc.Text & "'"
End If
End If
If Dacomyskmmc.Text <> "" Then
If str = "" Then
str = "yskmmc like '" & Dacomyskmmc.Text & "'"
Else
str = str & " and yskmmc like '" & Dacomyskmmc.Text & "'"
End If
End If
If Dacomgsbmmc.Text <> "" Then
If str = "" Then
str = "gsbmmc like '" & Dacomgsbmmc.Text & "'"
Else
str = str & " and gsbmmc like '" & Dacomgsbmmc.Text & "'"
End If
End If
If str <> "" Then
'str = str & " and qdsj>='" & DTPicker1.Value & "' and qdsj<='" & DTPicker2.Value & "' and wgsj >='" & DTPicker3.Value & "' and wgsj <='" & DTPicker4.Value & "'"
str = str & " and fsrq>='" & Format(DTPicker1.Value, "yyyy-MM-dd") & "' and fsrq<='" & Format(DTPicker2.Value, "yyyy-MM-dd") & "'"
'str = str & " and qdsj>='" & Format(DTPicker1.Value, "yyyy-MM-dd") & "' and qdsj<='" & Format(DTPicker2.Value, "yyyy-MM-dd") & "'and wgsj >='" & Format(DTPicker3.Value, "yyyy-MM-dd") & "'and wgsj <='" & Format(DTPicker4.Value, "yyyy-MM-dd") & "'"
Else
'str = "qdsj>='" & DTPicker1.Value & "' and qdsj<='" & DTPicker2.Value & "' and cast(wgsj as datetime) >='" & DTPicker3.Value & "' and cast(wgsj as datetime) <='" & DTPicker4.Value & "'"
str = "fsrq>='" & Format(DTPicker1.Value, "yyyy-MM-dd") & "' and fsrq<='" & Format(DTPicker2.Value, "yyyy-MM-dd") & "'"
'str = "qdsj>='" & Format(DTPicker1.Value, "yyyy-MM-dd") & "' and qdsj<='" & Format(DTPicker2.Value, "yyyy-MM-dd") & "' and wgsj >='" & Format(DTPicker3.Value, "yyyy-MM-dd") & "' and wgsj <='" & Format(DTPicker4.Value, "yyyy-MM-dd") & "'"
End If
rskjyw.Filter = str
strtemp = str
Labeljl.Caption = "本次查询共有" & rskjyw.RecordCount & "条记录"
Exit Sub
Case 1 '清空条件
Dim setcontrol As Control
For Each setcontrol In Me.Controls
If TypeName(setcontrol) = "DataCombo" Then
setcontrol.Text = ""
End If
Next
DTPicker1.Value = "1980-9-1"
DTPicker2.Value = Date
rskjyw.Filter = "pzhm <>0"
strtemp = "pzhm<>''"
Labeljl.Caption = "本次查询共有" & rskjyw.RecordCount & "条记录"
Exit Sub
Case 2 '输出至excel
If rskjyw.EOF Then
Exit Sub
End If
Dim i As Integer
Dim j As Integer
Dim m As Integer
Dim n As Integer
Set xlApp = CreateObject("excel.application")
Dim xlBook As Object
Dim xlSheet As Object
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
j = DataGrid1.Columns.Count
'xlSheet.Cells(1, 1) = "klklklklklklklklklklkkllll"
i = 1
For n = 1 To j - 1
If DataGrid1.Columns(n).Visible = True Then
xlSheet.Cells(2, i) = DataGrid1.Columns(n).Caption
i = i + 1
End If
Next n
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -