📄 使用计划汇总查询.frm
字号:
VERSION 5.00
Begin VB.Form frmCollectionQuery
BorderStyle = 1 'Fixed Single
Caption = "使用计划汇总查询"
ClientHeight = 3465
ClientLeft = 3915
ClientTop = 3030
ClientWidth = 5775
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3465
ScaleWidth = 5775
Begin VB.CommandButton btnCurName
Height = 255
Left = 5040
Style = 1 'Graphical
TabIndex = 9
Top = 480
Visible = 0 'False
Width = 255
End
Begin VB.TextBox txtCurName
Height = 270
Left = 1440
TabIndex = 0
ToolTipText = "请用逗号(,)间隔"
Top = 480
Width = 3615
End
Begin VB.Frame Frame1
Height = 2775
Left = 120
TabIndex = 16
Top = 120
Width = 5535
Begin VB.TextBox txtPrjName
Height = 270
Left = 1320
TabIndex = 2
ToolTipText = "请用逗号(,)间隔"
Top = 1320
Width = 3615
End
Begin VB.TextBox txtUnitName
Height = 270
Left = 1320
TabIndex = 1
ToolTipText = "请用逗号(,)间隔"
Top = 840
Width = 3615
End
Begin VB.TextBox txtSDeclare
Alignment = 1 'Right Justify
Height = 270
Left = 1320
TabIndex = 3
Top = 1785
Width = 1575
End
Begin VB.TextBox txtEDeclare
Alignment = 1 'Right Justify
Height = 270
Left = 3360
TabIndex = 4
Top = 1785
Width = 1575
End
Begin VB.TextBox txtEApprove
Alignment = 1 'Right Justify
Height = 270
Left = 3360
TabIndex = 6
Top = 2280
Width = 1575
End
Begin VB.TextBox txtSApprove
Alignment = 1 'Right Justify
Height = 270
Left = 1320
TabIndex = 5
Top = 2265
Width = 1575
End
Begin VB.CommandButton btnSDeclare
Height = 255
Left = 2880
Style = 1 'Graphical
TabIndex = 12
Top = 1800
Visible = 0 'False
Width = 255
End
Begin VB.CommandButton btnEDeclare
Height = 255
Left = 4920
Style = 1 'Graphical
TabIndex = 13
Top = 1800
Visible = 0 'False
Width = 255
End
Begin VB.CommandButton btnSApprove
Height = 255
Left = 2880
Style = 1 'Graphical
TabIndex = 14
Top = 2280
Visible = 0 'False
Width = 255
End
Begin VB.CommandButton btnEApprove
Height = 255
Left = 4920
Style = 1 'Graphical
TabIndex = 15
Top = 2280
Visible = 0 'False
Width = 255
End
Begin VB.CommandButton btnPrjName
Height = 255
Left = 4920
Style = 1 'Graphical
TabIndex = 11
Top = 1320
Visible = 0 'False
Width = 255
End
Begin VB.CommandButton btnUnitName
Height = 255
Left = 4920
Style = 1 'Graphical
TabIndex = 10
Top = 840
Visible = 0 'False
Width = 255
End
Begin VB.Label Label7
Caption = "至"
Height = 255
Left = 3000
TabIndex = 23
Top = 2280
Width = 255
End
Begin VB.Label Label1
Caption = "至"
Height = 255
Left = 3000
TabIndex = 22
Top = 1800
Width = 255
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "项目名称 :"
Height = 255
Left = 240
TabIndex = 21
Top = 1320
Width = 975
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
Caption = "币 别 :"
Height = 255
Left = 240
TabIndex = 20
Top = 360
Width = 975
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
Caption = "单位名称 :"
Height = 255
Left = 240
TabIndex = 19
Top = 840
Width = 975
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
Caption = "审核日期 :"
Height = 255
Left = 240
TabIndex = 18
Top = 2280
Width = 975
End
Begin VB.Label Label6
Alignment = 1 'Right Justify
Caption = "申报日期 :"
Height = 255
Left = 240
TabIndex = 17
Top = 1800
Width = 975
End
End
Begin VB.CommandButton btnOK
Caption = "确定"
Height = 375
Left = 3120
TabIndex = 7
Top = 3000
Width = 1095
End
Begin VB.CommandButton btnQuit
Cancel = -1 'True
Caption = "退出"
Height = 375
Left = 4560
TabIndex = 8
Top = 3000
Width = 1095
End
End
Attribute VB_Name = "frmCollectionQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_sWhere As String
Private m_strCur As String
'业务方法
Public Property Get where() As String
where = m_sWhere
End Property
Public Property Get Cur() As String
Cur = m_strCur
End Property
Private Function GetQuery() As String
Dim strTmp As String
GetQuery = "where fd_budgetdata.scurcode='" & m_strCur & "' and fd_budgethead.btype='1' and (fd_budgetdata.mdeclare>0 or fd_budgetdata.mapprove>0) "
'单位
If txtUnitName.Text <> "" Then
GetQuery = GetQuery & " and fd_accunit.cUnitName in (" & FillWithDot(txtUnitName.Text) & ") "
End If
'项目
If txtPrjName.Text <> "" Then
GetQuery = GetQuery & " and fd_projdef.sprjname in (" & FillWithDot(txtPrjName.Text) & ") "
Else '不能是合计类
GetQuery = GetQuery & " and fd_budgetdata.islid > 0 and fd_budgetdata.iflid > 0"
End If
'申报日期
If txtSDeclare.Text <> "" Then
GetQuery = GetQuery & " and fd_budgethead.ddeclare >= '" & txtSDeclare.Text & "' "
End If
If txtEDeclare.Text <> "" Then
GetQuery = GetQuery & " and fd_budgethead.ddeclare <= '" & txtEDeclare.Text & "' "
End If
'审批日期
If txtSApprove.Text <> "" Then
GetQuery = GetQuery & " and fd_budgethead.dapprove >= '" & txtSApprove.Text & "' "
End If
If txtEDeclare.Text <> "" Then
GetQuery = GetQuery & " and fd_budgethead.dapprove <= '" & txtEApprove.Text & "' "
End If
GetQuery = GetQuery & " group by fd_projdef.bprjclass,fd_projdef.sprjname,fd_accunit.cUnitName"
End Function
Private Sub btnCurName_Click()
Dim rtn As ADODB.Recordset
Dim str As String
Dim Node As IXMLDOMElement
On Error Resume Next
Set Node = m_objRefTree.documentElement.selectSingleNode("cur")
Set rtn = objShowCommonRef(Node.getAttribute("sql"), Node.getAttribute("fieldname"))
If rtn Is Nothing Then
Exit Sub
End If
While Not rtn.EOF
str = str & "" & rtn(Node.getAttribute("showfield")) & ","
rtn.MoveNext
Wend
If str <> "" Then
txtCurName.Text = mID(str, 1, Len(str) - 1)
End If
End Sub
Private Sub btnCurName_LostFocus()
btnCurName.Visible = False
End Sub
Private Sub btnEApprove_LostFocus()
btnEApprove.Visible = False
End Sub
Private Sub btnEDeclare_LostFocus()
btnEDeclare.Visible = False
End Sub
Private Sub btnPrjName_LostFocus()
btnPrjName.Visible = False
End Sub
Private Sub btnSApprove_LostFocus()
btnSApprove.Visible = False
End Sub
Private Sub btnSDeclare_LostFocus()
btnSDeclare.Visible = False
End Sub
Private Sub btnUnitName_LostFocus()
btnUnitName.Visible = False
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF1 Then
SendKeys "{F1}"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -