frmyh_yetjbcx.frm

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

 '填加合计行
    Dim ddwzmye As Double
    Dim ddzdye As Double
    Dim dtzckye As Double
   
    Dim sWbdw As String
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    sSQLTemp = "SELECT tZW_Yhdzqyrq.kmdm,kmmc,wbdw,qyrq,jzrq FROM tZW_Yhdzqyrq, tZW_Km" & glo.sOperateYear & _
                " WHERE rtrim(tZW_Yhdzqyrq.kmdm) = rtrim(tZW_Km" & glo.sOperateYear & ".kmdm) order by wbdw,tZW_Yhdzqyrq.kmdm"
    rstTemp.Open sSQLTemp, glo.cnnMain, adOpenStatic, adLockReadOnly
    With rstTemp
        mfgYetjbcx.Rows = 1
        mfgYetjbcx.ColAlignment(0) = flexAlignLeftCenter

        If .RecordCount > 0 Then
            m_bArr = True
            ReDim ArrYetjb(1 To .RecordCount)
            .MoveFirst
            i = 0
            sWbdw = FormatToString(.Fields("Wbdw").value)
            ddwzmye = 0
            ddzdye = 0
            dtzckye = 0
            Do Until .EOF
                Yhtzqye = 0
                Yhys = 0
                Yhyf = 0
                Yhtzhye = 0
                Dwtzqye = 0
                Dwys = 0
                Dwyf = 0
                Dwtzhye = 0
                i = i + 1
                kmdm = Trim$("" & .Fields("kmdm").value)
                Kmmc = Trim$("" & .Fields("kmmc").value) & "(" & kmdm & ")"
                JzRq = IIf(Format(.Fields("jzrq").value, "yyyy-mm-dd") > Format(.Fields("qyrq").value, "yyyy-mm-dd"), Format(.Fields("jzrq").value, "yyyy-mm-dd"), Format(.Fields("qyrq").value, "yyyy-mm-dd"))
                Call GetYetjb(kmdm, JzRq, Yhtzqye, Yhys, Yhyf, Yhtzhye, Dwtzqye, Dwys, Dwyf, Dwtzhye)
                ArrYetjb(i).Kmmc = Kmmc
                ArrYetjb(i).JzRq = JzRq
                ArrYetjb(i).Yhtzqye = Yhtzqye
                ArrYetjb(i).Yhys = Yhys
                ArrYetjb(i).Yhyf = Yhyf
                ArrYetjb(i).Yhtzhye = Yhtzhye
                ArrYetjb(i).Dwtzqye = Dwtzqye
                ArrYetjb(i).Dwys = Dwys
                ArrYetjb(i).Dwyf = Dwyf
                ArrYetjb(i).Dwtzhye = Dwtzhye
                If FormatToString(.Fields("wbdw").value) <> sWbdw Then
                    If sWbdw = "" Then sWbdw = "本位币"
                    mfgYetjbcx.AddItem "合   计 [" + sWbdw + "]：" & vbTab & "" & vbTab & Format(ddwzmye, "###,###,###,##0.00") & vbTab & Format(ddzdye, "###,###,###,##0.00") & vbTab & Format(dtzckye, "###,###,###,##0.00")
                    sWbdw = FormatToString(.Fields("Wbdw").value)
                    ddwzmye = 0
                    ddzdye = 0
                    dtzckye = 0
                End If
                mfgYetjbcx.AddItem Kmmc & vbTab & _
                                   JzRq & vbTab & _
                                   Format(Dwtzqye, "##,##0.00") & vbTab & _
                                   Format(Yhtzqye, "##,##0.00") & vbTab & _
                                   IIf(Abs((Yhtzhye - Dwtzhye)) < 0.01, Format(Yhtzhye, "##,##0.00"), Format(Abs(Yhtzhye - Dwtzhye), "###,###,###,##0.00")) & vbTab & i
                If FormatToString(.Fields("wbdw").value) = sWbdw Then
                    ddwzmye = ddwzmye + IIf(mfgYetjbcx.TextMatrix(mfgYetjbcx.Rows - 1, 2) <> "", (mfgYetjbcx.TextMatrix(mfgYetjbcx.Rows - 1, 2)), 0)
                    ddzdye = ddzdye + IIf(mfgYetjbcx.TextMatrix(mfgYetjbcx.Rows - 1, 3) <> "", (mfgYetjbcx.TextMatrix(mfgYetjbcx.Rows - 1, 3)), 0)
                    dtzckye = dtzckye + IIf(mfgYetjbcx.TextMatrix(mfgYetjbcx.Rows - 1, 4) <> "", (mfgYetjbcx.TextMatrix(mfgYetjbcx.Rows - 1, 4)), 0)
                End If
               .MoveNext
            Loop
            If sWbdw = "" Then sWbdw = "本位币"
            mfgYetjbcx.AddItem "合   计[" + sWbdw + "]：" & vbTab & "" & vbTab & Format(ddwzmye, "###,###,###,##0.00") & vbTab & Format(ddzdye, "###,###,###,##0.00") & vbTab & Format(dtzckye, "###,###,###,##0.00")
'            sWbdw = FormatToString(.Fields("Wbdw").Value)
        Else
            m_bArr = False
        End If
    End With
    Set rstTemp = Nothing
    If mfgYetjbcx.Rows > 1 Then
       mfgYetjbcx.Row = 1
    End If
    With mfgYetjbcx
        For i = 1 To .Rows - 1
            .RowHeight(i) = 320
            For j = 0 To .Cols - 1
                .Col = j
                .CellFontSize = 9
            Next j
        Next i
        .SelectionMode = flexSelectionByRow
    End With
End Sub

'计算期末余额调节表
Private Sub GetYetjb(ByVal kmdm As String, ByVal JzRq As String, ByRef Yhtzqye As Double, _
                    ByRef Yhys As Double, ByRef Yhyf As Double, ByRef Yhtzhye As Double, _
                    ByRef Dwtzqye As Double, ByRef Dwys As Double, ByRef Dwyf As Double, _
                    ByRef Dwtzhye As Double)
    Dim rstTemp As ADODB.Recordset
    Dim sSQL As String
    Dim rstDwf As ADODB.Recordset
    Dim rstYhf As ADODB.Recordset
    Dim sSQLDwf As String
    Dim sSQLYhf As String
    Dim sQueryStr As String
    Dim Yhdzqyrq As String
    
    Dim s As String
    If GetKmWbdw(kmdm) = "" Then
        s = "je"
    Else
        s = "wb"
    End If
    '从银行对账启用日期表中取出银行对账启用日期
    '如果银行对账启用日期等于当前注册年份, 则yhdzqyrq等于字段"qyrq"值;
    '否则yhdzqyrq等于"当前注册年份-01-01"
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    sSQL = "SELECT qyrq FROM tZW_Yhdzqyrq WHERE kmdm = '" & kmdm & "'"
    rstTemp.Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
    With rstTemp
        If .RecordCount > 0 Then
            If Year(.Fields("qyrq").value) = CInt(glo.sOperateYear) Then
                Yhdzqyrq = Format(.Fields("qyrq").value, "yyyy-mm-dd")
            Else
                Yhdzqyrq = glo.sOperateYear & "-01-01"
            End If
        Else
            Yhdzqyrq = glo.sOperateYear & "-01-01"
        End If
    End With
    
    '计算单位方
    Set rstDwf = New ADODB.Recordset
    rstDwf.CursorLocation = adUseClient
    sQueryStr = " WHERE kmdm = '" & kmdm & "' AND (kjqj = 20 OR kjqj = 21) AND xgbz = '2'"
    sSQLDwf = "SELECT kjqj,pzrq,fx,je,yhdz_lqbz FROM tZW_Pzsj" & glo.sOperateYear & sQueryStr
    rstDwf.Open sSQLDwf, glo.cnnMain, adOpenStatic, adLockReadOnly
    While rstDwf.EOF = False
        If rstDwf.Fields("pzrq").value <= CDate(JzRq) _
                    Or (CDate(JzRq) < CDate(Yhdzqyrq)) Then
            If rstDwf.Fields("kjqj") = 20 Then
                Dwtzqye = Dwtzqye + FormatToDouble(rstDwf.Fields("je").value)
            Else
                If IsNull(rstDwf.Fields("yhdz_lqbz").value) Then
                    If rstDwf.Fields("fx").value = "借" Then
                        Dwys = Dwys + FormatToDouble(rstDwf.Fields("je").value)
                    Else
                        Dwyf = Dwyf + FormatToDouble(rstDwf.Fields("je").value)
                    End If
                End If
            End If
        End If
        rstDwf.MoveNext
    Wend
    rstDwf.Close
    
    If CDate(JzRq) >= CDate(Yhdzqyrq) Then
        sQueryStr = " WHERE kmdm = '" & kmdm & _
                "' AND (kjqj >= " & Month(CDate(Yhdzqyrq)) & _
                " AND kjqj <= " & Month(CDate(JzRq)) & ") AND xgbz = '2' "
        sSQLDwf = "SELECT kjqj,pzrq,fx," + s + " je,yhdz_lqbz FROM tZW_Pzsj" & glo.sOperateYear & sQueryStr
   
    rstDwf.Open sSQLDwf, glo.cnnMain, adOpenStatic, adLockReadOnly
    With rstDwf
        If .RecordCount <> 0 Then
            .MoveFirst
            Do Until .EOF
                '如果日期大于银行对账启用日期并且小于等于截止日期(或者截止日期小于启用日期)
                 If .Fields("pzrq").value <= CDate(JzRq) _
                    Or (CDate(JzRq) < CDate(Yhdzqyrq)) Then
                    '如果是期初单位调整前余额, 则将金额加到单位调整前余额
                    If .Fields("fx").value = "借" Then
                        '如果是每个月的银行账记录, 则将金额加到单位调整前余额;
                        If .Fields("kjqj").value < 20 Then
                            Dwtzqye = Dwtzqye + FormatToDouble(.Fields("je").value)
                        End If
                        '如果银行账记录的两清标志为空, 则将金额加到单位已收,银行未收
                        If IsNull(.Fields("yhdz_lqbz").value) Then
                            Dwys = Dwys + FormatToDouble(.Fields("je").value)
                        End If
                    Else
                        '如果是每个月的银行账记录, 则单位调整前余额减去该金额;
                        If .Fields("kjqj").value < 20 Then
                            Dwtzqye = Dwtzqye - FormatToDouble(.Fields("je").value)
                        End If
                        '如果银行账记录的两清标志为空, 则将金额加到单位已付,银行未付
                        If IsNull(.Fields("yhdz_lqbz").value) Then
                            Dwyf = Dwyf + FormatToDouble(.Fields("je").value)
                        End If
                    End If
                End If
                .MoveNext
            Loop
        End If
    End With
    rstDwf.Close
    End If
    Set rstDwf = Nothing
    
    '计算银行方
    Set rstYhf = New ADODB.Recordset
    rstYhf.CursorLocation = adUseClient
    If CDate(JzRq) < CDate(Yhdzqyrq) Then
        sQueryStr = " WHERE kmdm = '" & kmdm & _
                        "' AND (qcbz = 0 OR qcbz = 1)"
    Else
        sQueryStr = " WHERE kmdm = '" & kmdm & "'"
    End If
    sSQLYhf = "SELECT rq,qcbz,fx,je,lqbz FROM tZW_Yhdzd" & glo.sOperateYear & sQueryStr
    rstYhf.Open sSQLYhf, glo.cnnMain, adOpenStatic, adLockReadOnly
    With rstYhf
        If .RecordCount <> 0 Then
            .MoveFirst
            Do Until .EOF
                '如果日期大于银行对账启用日期并且小于等于截止日期(或截止日期小于启用日期)
'                If (.Fields("rq").Value >= CDate(Yhdzqyrq) And .Fields("rq").Value <= CDate(Jzrq)) _
'                    Or CDate(Jzrq) < CDate(Yhdzqyrq) Then
                If .Fields("rq").value <= CDate(JzRq) _
                    Or CDate(JzRq) < CDate(Yhdzqyrq) Then
                    
                    '如果是期初调整前余额,则将金额加到银行方调整前余额
                    If .Fields("qcbz").value = 0 Then
                        Yhtzqye = Yhtzqye + .Fields("je").value
                    Else
                        If .Fields("fx").value = "贷" Then
                            '如果是每个月的对账单,则将金额加到银行方调整前余额;
                            If .Fields("qcbz").value = 2 Then
                                Yhtzqye = Yhtzqye + .Fields("je").value
                            End If
                            '如果对账单的两清标志为空, 则将金额加到银行已收,单位未收
                            If IsNull(.Fields("lqbz").value) Then
                                Yhys = Yhys + .Fields("je").value
                            End If
                        Else
                            '如果是每个月的对账单,则银行方调整前余额减去该金额;
                            If .Fields("qcbz").value = 2 Then
                                Yhtzqye = Yhtzqye - .Fields("je").value
                            End If
                            '如果对账单的两清标志为空, 则将金额加到银行已付,单位未付
                            If IsNull(.Fields("lqbz").value) Then
                                Yhyf = Yhyf + .Fields("je").value
                            End If
                        End If
                    End If
                End If
                .MoveNext
            Loop
        End If
    End With
    rstYhf.Close
    Set rstYhf = Nothing
    Dwtzhye = Dwtzqye + Yhys - Yhyf
    Yhtzhye = Yhtzqye + Dwys - Dwyf
End Sub

Private Sub Form_Resize()
    If Me.WindowState <> 1 Then
        If Me.Height < 5000 Then
            Me.Height = 5000
        End If
        If Me.Width < 7000 Then
            Me.Width = 7000
        End If
        mfgYetjbcx.Width = Me.ScaleWidth - 2 * mfgYetjbcx.Left
        mfgYetjbcx.Height = Me.ScaleHeight - mfgYetjbcx.Top - 30
    End If