frmpz_search.frm

一个用VB写的财务软件源码

      Width           =   450
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "外币:"
      Height          =   180
      Left            =   3600
      TabIndex        =   48
      Top             =   4680
      Width           =   450
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "科目:"
      Height          =   180
      Left            =   480
      TabIndex        =   39
      Top             =   4320
      Width           =   450
   End
End
Attribute VB_Name = "frmPZ_Search"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1

'凭证查询条件输入


Enum SearchFunctionUD
    pzsForSearchOnly = 1    '仅用来查询(调出单张凭证用 frmPZ_SearchResultView)
    pzsforCheck             '用来显示结果后进行凭证复核(调出单张凭证用 frmPZ_Check)
    pzsForTotal             '在科目汇总时用来选择汇张的范围
    pzsForCollect           '将多张凭证汇总成一张凭证
End Enum

Dim m_uFunction As SearchFunctionUD
Dim m_aryKmCodeLen() As Integer     '科目编码长度数组(如3、5、7、7)

Private m_sSQL As String
Private m_sSqlDistinct As String


Public Ok As Boolean

Public Property Let SearchFunction(ByVal NewFunc As SearchFunctionUD)
    m_uFunction = NewFunc
End Property
Public Property Get SearchFunction() As SearchFunctionUD
    SearchFunction = m_uFunction
End Property

Public Property Get usSQL() As String
    usSQL = m_sSQL
End Property

Public Property Get usSqlDistinct() As String
    usSqlDistinct = m_sSqlDistinct
End Property

Private Sub cboFHr_KeyPress(KeyAscii As Integer)
Dim s As String
If LenB(cboFHr.text) > 11 And cboFHr.SelLength = 0 And KeyAscii <> vbKeyBack Then KeyAscii = 0
If cboFHr.SelStart > 0 Then
    s = Left$(cboFHr.text, cboFHr.SelStart - 1)
Else
    s = cboFHr.text
End If
s = s + chr(KeyAscii)
If cboFHr.SelLength + cboFHr.SelStart > 0 Then
    s = s + Mid$(cboFHr.text, cboFHr.SelStart + cboFHr.SelLength + 1)
End If
If SqlStringValid(s) = False Then
    KeyAscii = 0
End If

End Sub

Private Sub cboZDr_KeyPress(KeyAscii As Integer)
Dim s As String
If Len(cboZDr.text) > 11 And cboZDr.SelLength = 0 And KeyAscii <> vbKeyBack Then KeyAscii = 0
If cboZDr.SelStart > 0 Then
    s = Left$(cboZDr.text, cboZDr.SelStart - 1)
Else
    s = cboZDr.text
End If
s = s + chr(KeyAscii)
If cboZDr.SelLength + cboZDr.SelStart > 0 Then
    s = s + Mid$(cboZDr.text, cboZDr.SelStart + cboZDr.SelLength + 1)
End If
If SqlStringValid(s) = False Then
    KeyAscii = 0
End If
End Sub

Private Sub form_load()
    Dim sSQL As String
    Dim rSt As ADODB.Recordset
    Dim rstAuth As New Recordset
    Dim i As Integer
    Dim m_lAuthCount As Long
    
    '根据本窗体的不同作用进行设置
    Select Case m_uFunction
        Case 1
            Caption = "凭证查询条件"
            cmdMore.Visible = True
        Case 2
            Caption = "凭证复核条件"
            optEntire.Enabled = False
            optChalked.Enabled = False
            cmdMore.Visible = True
        Case 3
            Caption = "科目汇总范围"
            lblLevel.Visible = True
            txtLevel.Visible = True
            updLevel.Visible = True
        Case 4
            Caption = "凭证汇总范围"
            lblLevel.Visible = False
            txtLevel.Visible = False
            updLevel.Visible = False
        Case Else
            Err.Raise 5
    End Select
    
    'Fill combobox which show account periods
    For i = 0 To 12
        cboPeriod.AddItem glo.sOperateYear & "-" & Format(i, "00")
        cboPeriod.ItemData(cboPeriod.NewIndex) = i
    Next i
    
    'Locate to current login period
    'To subtract 1 because the combobox is based by zero
    cboPeriod.ListIndex = glo.iOperatePeriod
    'Fill dtpickers with login date
    dtpDateFrom.value = glo.sOperateDate
    dtpDateTo.value = glo.sOperateDate
    dtpOneDay.value = glo.sOperateDate
    
    Set rSt = New ADODB.Recordset
    With rSt
        .CursorLocation = adUseClient
    'Fill combobox which show voucher type
        .Open "SELECT * FROM tZW_type" & glo.sOperateYear & " ORDER BY signID", _
                glo.cnnMain, adOpenStatic, adLockReadOnly
        If .RecordCount <> 0 Then
            .MoveFirst
            Do Until .EOF
                cboPzType.AddItem .Fields("sign").value
                .MoveNext
            Loop
            If cboPzType.ListCount > 0 Then
                cboPzType.ListIndex = 0
            End If
        End If
        .Close
        
    'Fill combobox which show users
    With rSt
            .CursorLocation = adUseClient
            '求该子系统明细权限的个数
             .Open "SELECT COUNT(*) FROM tSYS_Auth WHERE authid LIKE '" & _
                 gloSys.sSubSysId & "%' AND bEnd=-1", _
                     gloSys.cnnSYS, adOpenStatic, adLockReadOnly
             If Not IsNull(.Fields(0).value) Then m_lAuthCount = .Fields(0).value
            .Close
            .Open "SELECT * FROM tSYS_User where rtrim(UserID)<>'0' order by UserID", gloSys.cnnSYS, adOpenStatic, adLockReadOnly
            Do Until .EOF
                rstAuth.Open "SELECT COUNT(*) FROM tSYS_UserAuth WHERE userid='" & _
                    .Fields("UserID").value & "' AND authid LIKE '" & _
                    gloSys.sSubSysId & "%' AND accountid='" & _
                    glo.sAccountID & _
                    "'", gloSys.cnnSYS, adOpenStatic, adLockReadOnly
                If IsNull(rstAuth.Fields(0).value) Or rstAuth.Fields(0).value < m_lAuthCount Then
                    If Not (.Fields("tiType").value = 1 And .Fields("UserID").value <> glo.sAccountID) Then
                        i = i + 1
                        cboZDr.AddItem "" & .Fields("userName").value
                        cboFHr.AddItem "" & .Fields("userName").value
                    End If
                End If
                rstAuth.Close
                .MoveNext
            Loop
            cboZDr.ListIndex = 0
            cboFHr.ListIndex = 0
            .Close
        End With
    
    '形成科目编码长度数组
        .Open "SELECT * FROM tUSU_dmjs WHERE Type='科目' ORDER BY JC", _
            glo.cnnMain, adOpenStatic, adLockReadOnly
        ReDim m_aryKmCodeLen(.RecordCount)
        i = 1
        .MoveFirst
        Do Until .EOF
            If i = 1 Then
                m_aryKmCodeLen(i) = .Fields("ws").value
            Else
                m_aryKmCodeLen(i) = m_aryKmCodeLen(i - 1) + .Fields("ws").value
            End If
            i = i + 1
            .MoveNext
        Loop
        .Close
    End With
    
    cboFx.AddItem " "
    cboFx.AddItem "借"
    cboFx.AddItem "贷"
    cboFx.ListIndex = 0
    
End Sub
Private Sub cmdOk_Click()
    Dim sStr(21 + 2) As String
    Dim i As Long, lLen As Long
    Dim sCode As String, sName As String
    Dim sTable As String
    Dim rSt As New Recordset
'一、检测各个条件的输入合法性
    If optDateSect.value Then
        'Check the year
        If Year(dtpDateFrom.value) > CInt(glo.sOperateYear) Then
            MsgBox "所选日期不在目前登录年份之内！", vbInformation
            dtpDateFrom.SetFocus
            Exit Sub
        End If
        If Year(dtpDateTo.value) <> CInt(glo.sOperateYear) Then
            MsgBox "所选日期不在目前登录年份之内！", vbInformation
            dtpDateTo.SetFocus
            Exit Sub
        End If
        'When select a time sect to query, the end date mustn't early _
                with the begin date
        If dtpDateTo.value < dtpDateFrom.value Then
            MsgBox "截止日期不应早于起始日期！", vbInformation
            dtpDateTo.SetFocus
            Exit Sub
        End If
    End If
    If optOneDay.value Then
        'Check the year
        If Year(dtpOneDay.value) <> CInt(glo.sOperateYear) Then
            MsgBox "所选日期不在目前登录年份之内！", vbInformation
            dtpOneDay.SetFocus
            Exit Sub
        End If
    End If
    If chkPzbh.value Then
        'Check whether empty
        If txtPzbhFrom.text = "" And txtPzbhTo.text = "" Then
            MsgBox "如果包含凭证编号条件，请填入至少一个编号！", vbInformation
            txtPzbhFrom.SetFocus
            Exit Sub
        End If
        'Check the relation
        If txtPzbhFrom.text <> "" And txtPzbhTo.text <> "" Then
            If Val(txtPzbhTo.text) < Val(txtPzbhFrom.text) Then
                MsgBox "请在此处填入较大的编号！", vbInformation
                txtPzbhTo.SetFocus
                Exit Sub
            End If
        End If
    End If
    
    '以下为辅助条件
    If Right$(cmdMore.Caption, 2) = "<<" Then
        '摘要
        i = 7
        With txtSummary
            If .text = "" Then
                sStr(i) = ""
            ElseIf SqlStringValid(.text) Then
                sStr(i) = "A.pzzy LIKE '%" & RTrim$(.text) & "%'"
            Else
                MsgBox e_MSG_SQLVALID, vbInformation
                Exit Sub
            End If
        End With
        '科目
        i = i + 1
        If Not CheckValid(txtSubject, "tZW_km" & glo.sOperateYear, _
            "kmdm", "kmmc", "此科目不存在！", "kmdm", sStr(i)) Then Exit Sub

        '金额
        i = i + 1
        If txtMoney1.text = "" And txtMoney2.text = "" Then
            sStr(i) = ""
        ElseIf Trim(txtMoney1.text) <> "" And Trim(txtMoney2.text) <> "" Then
            If Val(txtMoney1.text) > Val(txtMoney2.text) Then
                MsgBox "金额范围输入的下界值大于上界值！", vbInformation
                Call FullSelTextbox(txtMoney2)
                Exit Sub
            Else
                sStr(i) = "A.je>=" & Val(txtMoney1.text) & " AND A.je<=" & Val(txtMoney2.text)
            End If
        ElseIf txtMoney1.text <> "" Then
            sStr(i) = "A.je>=" & Val(txtMoney1.text)
        Else
            sStr(i) = "A.je<=" & Val(txtMoney2.text)
        End If
        '方向
        i = i + 1
        If Trim$(cboFx.text) = "" Then
            sStr(i) = ""
        Else
            sStr(i) = "A.fx='" & cboFx.text & "'"
        End If
        '外币
        i = i + 1
        If Trim(txtForeign1.text) = "" And txtForeign2.text = "" Then
            sStr(i) = ""
        ElseIf Trim(txtForeign1.text) <> "" And Trim(txtForeign2.text) <> "" Then
            If Val(txtForeign1.text) > Val(txtForeign2.text) Then
                MsgBox "外币范围输入的下界值大于上界值！", vbInformation
                Call FullSelTextbox(txtForeign2)
                Exit Sub
            Else
                sStr(i) = "A.wb>=" & Val(txtForeign1.text) & " AND A.wb<=" & Val(txtForeign2.text)
            End If
        ElseIf Trim(txtForeign1.text) <> "" Then
            sStr(i) = "A.wb>=" & Val(txtForeign1.text)
        Else
            sStr(i) = "A.wb<=" & Val(txtForeign2.text)
        End If
        '数量
        i = i + 1
        If Trim(txtAmount1.text) = "" And Trim(txtAmount2.text = "") Then
            sStr(i) = ""
        ElseIf Trim(txtAmount1.text) <> "" And Trim(txtAmount2.text <> "") Then
            If Val(txtAmount1.text) > Val(txtAmount2.text) Then
                MsgBox "数量范围输入的下界值大于上界值！", vbInformation
                Call FullSelTextbox(txtAmount2)
                Exit Sub
            Else
                sStr(i) = "A.sl>=" & Val(txtAmount1.text) & " AND A.sl<=" & Val(txtAmount2.text)
            End If
        ElseIf Trim(txtAmount1.text) <> "" Then
            sStr(i) = "A.sl>=" & Val(txtAmount1.text)
        Else
            sStr(i) = "A.sl<=" & Val(txtAmount2.text)
        End If
        '结算方式
        i = i + 1
        If Not CheckValid(txtCountMode, "tZW_Jsfs" & glo.sOperateYear, "cCode", "cName", _
            "此结算方式不存在！", "yhdz_jsfsCode", sStr(i)) Then Exit Sub
        '发生日期
        i = i + 1
        With txtOccurDate
            If .text = "" Then
                sStr(i) = ""
            ElseIf IsDate(.text) Then
                sStr(i) = "(A.yhdz_date=" & GetDateString(g_FLAT, .text) + ")"
            Else
                MsgBox "不合法的日期！", vbInformation
                Call FullSelTextbox(txtOccurDate)
                Exit Sub
            End If
        End With
        
        If Trim$(txtCBD) <> "" Or Trim$(txtPerson) <> "" Or Trim$(txtCustomer) <> "" Or Trim$(txtVendor) <> "" Then
            sTable = " ,tysyf_pzsj" + glo.sOperateYear + " B "
            i = i + 1
            sStr(i) = " A.pzzl=B.cKind and A.pzbh=B.cPzCode" + _
                " and A.Kjqj=B.Kjqj "
            '业务员
            i = i + 1
            If Trim$(txtCBD.text) <> "" Then
                Set rSt = New Recordset
                rSt.Open "Select * from " + GetPersTableName + " where zgbh='" + txtCBD + "' or  zgxm='" + txtCBD + "'", glo.cnnMain, adOpenKeyset, adLockOptimistic
                If rSt.EOF = True Then
                    MsgBox "此职工(业务员)不存在！", vbInformation
                    Exit Sub
                Else
                    sStr(i) = " B.cWorkCode='" + Trim$(rSt.Fields("zgbh").value) + "'"
                End If
            End If
            '个人
            i = i + 1
            If Trim$(txtPerson.text) <> "" Then
                Set rSt = New Recordset
                rSt.Open "Select * from " + GetPersTableName + " where zgbh='" + txtPerson + "' or  zgxm='" + txtPerson + "'", glo.cnnMain, adOpenKeyset, adLockOptimistic
                If rSt.EOF = True Then
                    MsgBox "此人员不存在！", vbInformation
                    Exit Sub
                Else
                    sStr(i) = " B.cPersonCode='" + Trim$(rSt.Fields("zgbh").value) + "'"
                End If
            End If