frmyjstj.frm

财务信息管理系统,适合做毕业论文的人使用

Private Sub label1_Click(Index As Integer)
    If Index = 6 Or Index = 7 Or Index = 8 Then
        Check1(Index - 6).Value = 1 - Check1(Index - 6).Value
    End If
End Sub

Private Sub Refyhmc_Initialize(Index As Integer)
    refyhmc(Index).InitSys 0, dbsZJ
    refyhmc(Index).InitSys 1, Edityhmc(Index).Text
    refyhmc(Index).RefUnitMode = IIf(cxnwb = 1 And Index = 0, RefBank, RefNotBank)       'Cuidong 2000/06/26
End Sub

Private Sub Refyhmc_RefCancel(Index As Integer)
    Edityhmc(Index).SetFocus
End Sub

Private Sub Refyhzh_RefCancel(Index As Integer)
    Edityhzh(Index).SetFocus
End Sub

Private Sub Refyhzh_Initialize(Index As Integer)
    Refyhzh(Index).InitSys 0, dbsZJ
    Refyhzh(Index).InitSys 1, Edityhzh(Index).Text
    Refyhzh(Index).InitSys 2, Edityhmc(Index).Text
End Sub

Private Sub Refyhmc_RefOK(Index As Integer, Code As String)
    Edityhmc(Index).Text = Code
    Edityhmc(Index).SetFocus
End Sub

Private Sub Refyhzh_RefOK(Index As Integer, Code As String)
    Edityhzh(Index).Text = Code
    Edityhzh(Index).SetFocus
End Sub

Private Sub Editbh_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        SendKeys "{Tab}"
    End If
End Sub

Private Sub Editbh_LostFocus(Index As Integer)
    If Len(Editbh(Index).Text) > 0 Then
        Editbh(Index).Text = Right("00000000" + Editbh(Index).Text, 8)
    End If
End Sub
' 业务日期按键
Private Sub Editrq_Keyup(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 And isEnt Then
        SendKeys "{Tab}"
    End If
    If KeyCode = 113 Then    'F2
        View_Calendar Me, Editrq(Index), 0
    End If
    isEnt = True
End Sub

Private Sub Editrq_LostFocus(Index As Integer)
    If Editrq(Index).Text <> "" And isEnt Then
        Editrq(Index).Text = ForDate(Editrq(Index).Text)
        If IsDate(Editrq(Index).Text) Then
            Editrq(Index).Text = Format(Editrq(Index).Text, "yyyy-mm-dd")
        Else
            Beep
            MsgBox "日期非法，请检查！", vbCritical, zjGl_Name
            SetTxtFocus Editrq(Index)
            isEnt = False
        End If
    End If
End Sub
' 银行名称按键
Private Sub Edityhmc_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        SendKeys "{Tab}"
    End If
    If KeyCode = 113 Then    'F2
        refyhmc(Index).RunReference
    End If
End Sub

Private Sub Edityhmc_LostFocus(Index As Integer)
    Dim rsTemp As New UfRecordset
    
    Edityhmc(Index).Text = Trim(Edityhmc(Index).Text)
    If Edityhmc(Index).Text <> "" Then
        Dim aa As String
        aa = Dwbmtodwmc(Edityhmc(Index).Text)
        If aa <> "" Then
            Edityhmc(Index).Text = aa
        End If
    End If
End Sub

Private Sub Edityhmc_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Edityhmc(Index).ToolTipText = Edityhmc(Index).Text
End Sub
' 银行账号按键
Private Sub Edityhzh_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        SendKeys "{Tab}"
    End If
    If KeyCode = 113 Then   'F2
        Refyhzh(Index).RunReference
    End If
End Sub
' 条件合法性检查
Private Function Contquit() As Boolean
    Contquit = False
    If Editrq(0).Text <> "" Then
        Editrq(0).Text = ForDate(Editrq(0).Text)
        If Not IsDate(Editrq(0).Text) Then
            Beep
            MsgBox "日期非法，请检查！", vbCritical, zjGl_Name
            SetTxtFocus Editrq(0)
            Exit Function
        End If
    End If
    
    If Editrq(1).Text <> "" Then
        Editrq(1).Text = ForDate(Editrq(1).Text)
        If IsDate(Editrq(1).Text) Then
            If Editrq(0).Text <> "" Then
                If CDate(Editrq(1).Text) < CDate(Editrq(0).Text) Then
                    Beep
                    MsgBox "日期范围错误，请检查！", vbCritical, zjGl_Name
                    SetTxtFocus Editrq(1)
                    Exit Function
                End If
            End If
        Else
            Beep
            MsgBox "日期非法，请检查！", vbCritical, zjGl_Name
            SetTxtFocus Editrq(1)
            Exit Function
        End If
    End If
    
    If Editbh(0).Text <> "" Then
        Editbh(0).Text = Right("00000000" + Editbh(0).Text, 8)
    End If
    
    If Editbh(1).Text <> "" Then
        Editbh(1).Text = Right("00000000" + Editbh(1).Text, 8)
        If Editbh(0).Text <> "" Then
            If Editbh(1).Text < Editbh(0).Text Then
                Beep
                MsgBox "业务编号范围错误，请检查！", vbCritical, zjGl_Name
                SetTxtFocus Editbh(1)
                Exit Function
            End If
        End If
    End If
    
    If Editje(1).Text <> "" And Editje(0).Text <> "" Then
        If CDbl(Editje(1).Text) < CDbl(Editje(0).Text) Then
            Beep
            MsgBox "金额范围错误，请检查！", vbCritical, zjGl_Name
            Editje(1).SetFocus
            Exit Function
        End If
    End If
    
    If Editje(3).Text <> "" And Editje(2).Text <> "" Then
        If CDbl(Editje(3).Text) < CDbl(Editje(2).Text) Then
            Beep
            MsgBox "金额范围错误，请检查！", vbCritical, zjGl_Name
            Editje(3).SetFocus
            Exit Function
        End If
    End If
    
    Contquit = True

End Function

Private Sub Cond_zh()

    Dim dwbm As String, ywzl As String, ssks As String, sfks As String
    Dim sSum As String 'cuidong 2001.09.17
    
    If cxnwb = 1 Then
        ssks = "收款"
        sfks = "付款"
        dwbm = Ywbhtoname("14")
        ywzl = "14"
        tjzh = "Select [igp_flag],[icen_id],[dbill_date],[cSetid],[cGAccID] As dwm1,[cGAccID],[cPAccID] As dwm2,[cPAccID],[mmoney],[cGAccID] As dwm3,[nfrat],[mmoney_f],[cdigest],[center_name],[cbank_name],[cbank_code],[crun_name],[cset_name],[cCheckCode],[cBookcode],[cBillCode] from FD_Settacc where cSetid like '" + ywzl + "%'"
        tjzh1 = "Select (case when [igp_flag]=0 then '" + ssks + "' else '" + sfks + "' end ),[icen_id],[dbill_date],'" + dwbm + "-' + right([cSetid],8) as zd1,[cGAccID] As dwm1,[cGAccID],[cPAccID] As dwm2,[cPAccID],[mmoney],FD_AccDef.cexch_name,[nfrat],[mmoney_f],[cdigest],[center_name],[cbank_name],[cbank_code],[crun_name],[cset_name],[cCheckCode],[cBookcode],[cBillCode] from FD_Settacc INNER JOIN FD_AccDef ON FD_Settacc.cGAccID = FD_AccDef.cAccID where cSetid like '" + ywzl + "%'"
        sSum = "Select '" & CX_SumTEXT & "', " & CX_SumCHARSQL & " as [icen_id], " & CX_SumCHARSQL & " as [dbill_date], " & CX_SumCHARSQL & " as zd1, " & CX_SumCHARSQL & " As dwm1, " & CX_SumCHARSQL & " as [cGAccID], " & CX_SumCHARSQL & " As dwm2, " & CX_SumCHARSQL & " as [cPAccID], Sum([mmoney]) As mMoney, FD_AccDef.cexch_name, " & CX_SumCHARSQL & " as [nfrat],Sum([mmoney_f]) As mMoney_f, " & CX_SumCHARSQL & " as [cdigest], " & CX_SumCHARSQL & " as [center_name], " & CX_SumCHARSQL & " as [cbank_name], " & CX_SumCHARSQL & " as [cbank_code], " & CX_SumCHARSQL & " as [crun_name], " & CX_SumCHARSQL & " as [cset_name], " & CX_SumCHARSQL & " as [cCheckCode], " & CX_SumCHARSQL & " as [cBookcode], " & CX_SumCHARSQL & " as [cBillCode] from FD_Settacc INNER JOIN FD_AccDef ON FD_Settacc.cGAccID = FD_AccDef.cAccID where cSetid like '" + ywzl + "%'"
    Else
        dwbm = Ywbhtoname("15")
        ywzl = "15"
        tjzh = "Select [dbill_date],[cSetid],[cGAccID] As dwm1,[cGAccID],[cPAccID] As dwm2,[cPAccID],[mmoney],[cPAccID],[nfrat],[mmoney_f],[cdigest],[crun_name],[cpay_name],[cset_name], [cCheckCode], [cBookcode], [cBillCode] from FD_Settacc where cSetid like '" + ywzl + "%'"
        tjzh1 = "Select [dbill_date],'" + dwbm + "-' + right([cSetid],8) as zd1,[cGAccID] As dwm1,[cGAccID],[cPAccID] As dwm2,[cPAccID],[mmoney],FD_AccDef.cexch_name,[nfrat],[mmoney_f],[cdigest],[crun_name],[cpay_name],[cset_name],[cCheckCode],[cBookcode],[cBillCode] from FD_Settacc INNER JOIN FD_AccDef ON FD_Settacc.cGAccID = FD_AccDef.cAccID where cSetid like '" + ywzl + "%'"
        sSum = "Select " & CX_SumCHARSQL & " As [dbill_date], '" & CX_SumTEXT & "' as zd1, " & CX_SumCHARSQL & " As dwm1," & CX_SumCHARSQL & " As [cGAccID], " & CX_SumCHARSQL & " As dwm2, " & CX_SumCHARSQL & " As [cPAccID],Sum([mmoney]) As mMoney,FD_AccDef.cexch_name," & CX_SumCHARSQL & " As [nfrat], Sum([mmoney_f]) As mMoney_f, " & CX_SumCHARSQL & " As [cdigest], " & CX_SumCHARSQL & " As [crun_name], " & CX_SumCHARSQL & " As [cpay_name], " & CX_SumCHARSQL & " As [cset_name], " & CX_SumCHARSQL & " As [cCheckCode], " & CX_SumCHARSQL & " As [cBookcode], " & CX_SumCHARSQL & " As [cBillCode] from FD_Settacc INNER JOIN FD_AccDef ON FD_Settacc.cGAccID = FD_AccDef.cAccID where cSetid like '" + ywzl + "%'"
    End If
        
    ssks = ""
    If Editbh(0).Text <> "" Then
        ssks = ssks + " And [cSetid] >= '" + ywzl + Editbh(0).Text + "'"
    End If
    If Editbh(1).Text <> "" Then
        ssks = ssks + " And [cSetid] <= '" + ywzl + Editbh(1).Text + "'"
    End If
    If Editrq(0).Text <> "" Then
        ssks = ssks + " And [dbill_date] >= '" + Editrq(0).Text + "'"
    End If
    If Editrq(1).Text <> "" Then
        ssks = ssks + " And [dbill_date] <= '" + Editrq(1).Text + "'"
    End If
    
    If Edityhmc(0).Text <> "" Then
        dwbm = Dwmctodwbm(Edityhmc(0).Text)
        If dwbm = "" Then
            dwbm = Dwbmtodwmc(Edityhmc(0).Text)
            If dwbm <> "" Then
                dwbm = Edityhmc(0).Text
            End If
        End If
        If dwbm = "" Then
            dwbm = Edityhmc(0).Text
        End If
        'If dwbm <> "" Then
            ssks = ssks + " And [cGAccid] in (Select cAccid from FD_accdef where cUnitCode = '" + dwbm + "')"
        'End If
    End If
    If Edityhmc(1).Text <> "" Then
        dwbm = Dwmctodwbm(Edityhmc(1).Text)
        If dwbm = "" Then
            dwbm = Dwbmtodwmc(Edityhmc(1).Text)
            If dwbm <> "" Then
                dwbm = Edityhmc(1).Text
            End If
        End If
        If dwbm = "" Then
            dwbm = Edityhmc(1).Text
        End If
        'If dwbm <> "" Then
            ssks = ssks + " And [cPAccid] in (Select cAccid from FD_accdef where cUnitCode = '" + dwbm + "')"
        'End If
    End If
    
    If Edityhzh(0).Text <> "" Then
        ssks = ssks + " And [cGAccid] = '" + Edityhzh(0).Text + "'"
    End If
    If Edityhzh(1).Text <> "" Then
        ssks = ssks + " And [cPAccid] = '" + Edityhzh(1).Text + "'"
    End If
    
    If Editje(0).Text <> "" Then
        ssks = ssks + " And [mmoney] >= " + Editje(0).Text
    End If
    If Editje(1).Text <> "" Then
        ssks = ssks + " And [mmoney] <= " + Editje(1).Text
    End If
    
    If Editje(2).Text <> "" Then
        ssks = ssks + " And [mmoney_f] >= " + Editje(2).Text
    End If
    If Editje(3).Text <> "" Then
        ssks = ssks + " And [mmoney_f] <= " + Editje(3).Text
    End If
    
    If cxnwb = 1 Then
        If Check1(0).Value <> Check1(1).Value Then
            ssks = ssks + " And [igp_flag] = " + IIf(Check1(0).Value = 1, "0", "1")
        End If
    End If
    
    If Check1(2).Value = 0 Then
        ssks = ssks + " And (not ([cBookCode] is null))"
    End If
    
    'cuidong S.A 2001.09.17
    '----------------------
    tjzh1 = tjzh1 & ssks
    tjzh1 = tjzh1 & vbCrLf
    tjzh1 = tjzh1 & " UNION ALL "
    tjzh1 = tjzh1 & vbCrLf
    tjzh1 = tjzh1 & sSum
    tjzh1 = tjzh1 & ssks
    tjzh1 = tjzh1 & "  Group By FD_AccDef.cexch_name"
    tjzh1 = tjzh1 & vbCrLf
    tjzh1 = tjzh1 & " order by zd1 desc, cexch_name, [dbill_date]"
    '----------------------
    
    ssks = ssks + " order by [dbill_date], cSetid"
    tjzh = tjzh + ssks
'    tjzh1 = tjzh1 + ssks 'cuidong S.A 2001.09.17
End Sub