frmyh_yhdzcx.frm

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

                aKmdm(curIndex) = Trim$("" & .Fields("kmdm").value)
                cboKmmc.AddItem Trim$("" & .Fields("kmmc").value) & "(" & Trim$("" & .Fields("kmdm").value) & ")"
                If Trim$("" & .Fields("kmdm").value) = frmYH_Yhkmxz.kmdm Then
                    cboKmmc.ListIndex = curIndex
                End If
                curIndex = curIndex + 1
                .MoveNext
            Loop
        End If
    End With
    cboViewselect.AddItem "全部显示"
    cboViewselect.AddItem "显示已达账"
    cboViewselect.AddItem "显示未达账"
    cboViewselect.ListIndex = 0
    
    oldKmdmListIndex = cboKmmc.ListIndex
    oldViewListIndex = cboViewselect.ListIndex
    
    stbYhdzcx.Tab = 0
    With stbYhdzcx
        If .Tab = 0 Then
            lblYhdzmc.Caption = "银行对账单"
        Else
            lblYhdzmc.Caption = "单位日记账"
        End If
    End With
    
    KmdmSelect = aKmdm(cboKmmc.ListIndex)
    
    
    ''''''''''''''''''''
     If GetKmWbdw(KmdmSelect) = "" Then
        s = "je"
    Else
        s = "wb"
    End If
    ''''''''''''''''
    '从银行对账启用日期表中取出银行对账启用日期
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    sSQL = "SELECT * FROM tZW_Yhdzqyrq WHERE kmdm = '" & KmdmSelect & "'"
    rstTemp.Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
    With rstTemp
        If .RecordCount <> 0 Then
            If Year(.Fields("qyrq").value) < CInt(glo.sOperateYear) Then
                bTheSameYear = 0
            ElseIf Year(.Fields("qyrq").value) = CInt(glo.sOperateYear) Then
                bTheSameYear = 1
            Else
                bTheSameYear = 2
            End If
            Yhdzqyrq = Format(.Fields("qyrq").value, "yyyy-mm-dd")
        Else
            bTheSameYear = 0
        End If
    End With
        
    sSQLYhdzd = "SELECT * FROM tZW_Yhdzd" & glo.sOperateYear & _
                " WHERE kmdm = '" & KmdmSelect & _
                "' AND qcbz <> 0 AND hxbz = 0 ORDER BY rq,jsfsCode,Bill"
                
    '如果当前注册年份和银行对账启用年份相同
    sQueryStr = ""
    If bTheSameYear = 1 Then
        sQueryStr = " WHERE kmdm = '" & KmdmSelect & _
                    "' AND ((kjqj >= " & Month(CDate(Yhdzqyrq)) & _
                    " AND kjqj <= 12)" & " OR kjqj = 21)" & _
                    " AND yhdz_hxbz = 0"
    ElseIf bTheSameYear = 2 Then
        sQueryStr = " WHERE kmdm = '" & KmdmSelect & _
                    "' AND ((kjqj >= 1 AND kjqj <= 12)" & " OR kjqj = 21)" & _
                    " AND yhdz_hxbz = 0"
    End If
    
    sSQLDwrjz = "SELECT pzzl,pzbh,pzrq,pzzy,fx," + s + " je,yhdz_jsfscode," & _
                "yhdz_bill,yhdz_date,yhdz_lqbz" & _
                " FROM tZW_Pzsj" & glo.sOperateYear & sQueryStr & _
                " ORDER BY pzrq"
                
    Call SetHead
    Call FillGridYhdzd(sSQLYhdzd)
    Call FillGridDwrjz(sSQLDwrjz)
    
    '------------------------------
    '得到当前账套的单位名称
    sEnterName = GetDWMC
    If sEnterName = "" Then
        MsgBox "缺少单位名称！", vbInformation
        Exit Sub
    End If
    
    '根据当前MSFLEXGRID表格生成CELL表格
    If IsChangeCurrentTable Then
        IsChangeCurrentTable = False
        Call DrawCellTable
    End If
    
    '------------------------------
    bFormload = False
    Load frmYH_Yhcxtj
    fMainForm.MousePointer = vbDefault
    
End Sub

'设置表头
Private Sub SetHead()
    With mfgYhdzd
        .ColWidth(0) = 1200
        .ColWidth(1) = 1600
        .ColWidth(2) = 1000
        .ColWidth(3) = 1800
        .ColWidth(4) = 1800
        .ColWidth(5) = 600
        .ColWidth(6) = 2000
        
        .ColAlignment(0) = 4
        .ColAlignment(1) = 4
        .ColAlignment(2) = 4
        .ColAlignment(3) = 7
        .ColAlignment(4) = 7
        .ColAlignment(5) = 4
        .ColAlignment(6) = 1
        .row = 0
        .RowHeight(0) = 300
        For j = 0 To .Cols - 1
            .col = j
            .CellAlignment = 4
        Next j
    End With
    
    With mfgDwrjz
        .ColWidth(0) = 1200
        .ColWidth(1) = 1200
        .ColWidth(2) = 1600
        .ColWidth(3) = 1000
        .ColWidth(4) = 1800
        .ColWidth(5) = 1800
        .ColWidth(6) = 600
        .ColWidth(7) = 1000
        .ColWidth(8) = 1000
        .ColWidth(9) = 2000
        
        .ColAlignment(0) = 4
        .ColAlignment(1) = 4
        .ColAlignment(2) = 4
        .ColAlignment(3) = 4
        .ColAlignment(4) = 7
        .ColAlignment(5) = 7
        .ColAlignment(6) = 4
        .ColAlignment(7) = 4
        .ColAlignment(8) = 4
        .ColAlignment(9) = 1
        .row = 0
        .RowHeight(0) = 300
        For j = 0 To .Cols - 1
            .col = j
            .CellAlignment = 4
        Next j
    End With
End Sub

'填充银行对账单
Private Sub FillGridYhdzd(ByVal sSQLYhdzd As String)
    Dim rstYhdzd As ADODB.Recordset
    Dim dTotalYhJfje As Double                  '银行方合计借方金额
    Dim dTotalYhDfje As Double                  '银行方合计贷方金额
    
    dTotalYhJfje = 0
    dTotalYhDfje = 0
'    mfgYhdzd.Redraw = False
    mfgYhdzd.Rows = 1
    
    If bTheSameYear > 0 Then
        Set rstYhdzd = New ADODB.Recordset
        With rstYhdzd
            .CursorLocation = adUseClient
            .Open sSQLYhdzd, glo.cnnMain, adOpenStatic, adLockReadOnly
            If .RecordCount <> 0 Then
                .MoveFirst
                For i = 1 To .RecordCount
                    mfgYhdzd.AddItem Format(.Fields("rq").value, "yyyy-mm-dd") & vbTab & _
                                     Trim$("" & .Fields("jsfsCode").value) + " " + GetJsfsName(Trim$("" & .Fields("jsfsCode").value)) & vbTab & _
                                     Trim$("" & .Fields("bill").value) & vbTab & _
                                     IIf(.Fields("fx") = "借", Format(.Fields("je").value, "##,##0.00"), "") & vbTab & _
                                     IIf(.Fields("fx") = "贷", Format(.Fields("je").value, "##,##0.00"), "") & vbTab & _
                                     IIf(IsNull(.Fields("lqbz").value), "", IIf(.Fields("lqbz").value = 1, "○", "√")) & vbTab & _
                                     Trim$("" & .Fields("zy").value) & vbTab & i
                    If (.Fields("lqbz").value) > 0 Then
                        mfgYhdzd.row = i
                        For j = 0 To mfgYhdzd.Cols - 1
                            mfgYhdzd.col = j
                            mfgYhdzd.CellBackColor = &HFFFFC0
                        Next j
                    End If
                    If .Fields("fx").value = "借" Then
                        dTotalYhJfje = dTotalYhJfje + .Fields("je").value
                    Else
                        dTotalYhDfje = dTotalYhDfje + .Fields("je").value
                    End If
                    .MoveNext
                Next i
                mfgYhdzd.AddItem "合计：" & vbTab & "" & vbTab & "" & vbTab & _
                                 IIf(Abs(dTotalYhJfje) >= 0.01, Format(dTotalYhJfje, "##,##0.00"), "") & vbTab & _
                                 IIf(Abs(dTotalYhDfje) >= 0.01, Format(dTotalYhDfje, "##,##0.00"), "") & vbTab & _
                                 "" & vbTab & "" & vbTab & i
                mfgYhdzd.row = i
                For j = 0 To mfgYhdzd.Cols - 1
                    mfgYhdzd.col = j
                    mfgYhdzd.CellBackColor = &HC0FFC0       '淡绿色
                Next j
            End If
        End With
    End If
'    mfgYhdzd.Redraw = True
    mfgYhdzd.SelectionMode = flexSelectionByRow
End Sub

'填充单位日记账
Private Sub FillGridDwrjz(ByVal sSQLDwrjz As String)
    Dim rstDwrjz As ADODB.Recordset
    Dim dTotalDwJfje As Double                  '单位方合计借方金额
    Dim dTotalDwDfje As Double                  '单位方合计贷方金额
    Dim iRow As Integer
    
    dTotalDwJfje = 0
    dTotalDwDfje = 0
'    mfgDwrjz.Redraw = False
    mfgDwrjz.Rows = 1
    
    If bTheSameYear > 0 Then
        Set rstDwrjz = New ADODB.Recordset
        With rstDwrjz
            .CursorLocation = adUseClient
            .Open sSQLDwrjz, glo.cnnMain, adOpenStatic, adLockReadOnly
            If Not (.EOF And .BOF) Then
                .MoveFirst
                iRow = 0
                For i = 1 To .RecordCount
                    '=================================2002.8.18   yao ===revise============================
'                    If (bTheSameYear = 1 And .Fields("pzrq").Value >= CDate(Yhdzqyrq)) _
'                        Or bTheSameYear = 2 Then
                    If FormatToDouble(.Fields("je").value) <> 0 Then
                        If (bTheSameYear = 1 And .Fields("pzrq").value >= CDate(Yhdzqyrq)) _
                            Or bTheSameYear = 2 Then
                        '====================================================================================
                        
                            
                            iRow = iRow + 1
                            mfgDwrjz.AddItem Format(.Fields("pzrq").value, "yyyy-mm-dd") & vbTab & _
                                             Format(.Fields("yhdz_date").value, "yyyy-mm-dd") & vbTab & _
                                             Trim$("" & .Fields("yhdz_jsfsCode").value) + " " + GetJsfsName(Trim$("" & .Fields("yhdz_jsfsCode").value)) & vbTab & _
                                             Trim$("" & .Fields("yhdz_bill").value) & vbTab & _
                                             IIf(.Fields("fx").value = "借", Format(.Fields("je").value, "##,##0.00"), "") & vbTab & _
                                             IIf(.Fields("fx").value = "贷", Format(.Fields("je").value, "##,##0.00"), "") & vbTab & _
                                             IIf(IsNull(.Fields("yhdz_lqbz").value), "", IIf(.Fields("yhdz_lqbz").value = 1, "○", "√")) & vbTab & _
                                             .Fields("pzzl").value & vbTab & _
                                             .Fields("pzbh").value & vbTab & _
                                             Trim$("" & .Fields("pzzy").value) & vbTab & iRow
                            If (.Fields("yhdz_lqbz").value) > 0 Then
                                mfgDwrjz.row = iRow
                                For j = 0 To mfgDwrjz.Cols - 1
                                    mfgDwrjz.col = j
                                    mfgDwrjz.CellBackColor = &HFFFFC0
                                Next j
                            End If
                            If .Fields("fx").value = "借" Then
                                dTotalDwJfje = dTotalDwJfje + .Fields("je").value
                            Else
                                dTotalDwDfje = dTotalDwDfje + .Fields("je").value
                            End If
                        End If
                    End If
                    .MoveNext
                Next i
                mfgDwrjz.AddItem "合计：" & vbTab & "" & vbTab & "" & vbTab & "" & vbTab & _
                                 IIf(Abs(Format(dTotalDwJfje, "##,##0.00")) >= 0.01, Format(dTotalDwJfje, "##,##0.00"), " ") & vbTab & _
                                 IIf(Abs(Format(dTotalDwDfje, "##,##0.00")) >= 0.01, Format(dTotalDwDfje, "##,##0.00"), " ") & vbTab & _
                                 "" & vbTab & "" & vbTab & "" & vbTab & "" & vbTab & iRow + 1
                mfgDwrjz.row = iRow + 1
                For j = 0 To mfgDwrjz.Cols - 1
                    mfgDwrjz.col = j
                    mfgDwrjz.CellBackColor = &HC0FFC0           '淡绿色
                Next j
            End If
        End With
    End If
'    mfgDwrjz.Redraw = True
    mfgDwrjz.SelectionMode = flexSelectionByRow
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
        lblYhdzmc.Left = (Me.ScaleWidth - lblYhdzmc.Width) / 2
        cboViewselect.Left = Me.ScaleWidth - cboViewselect.Width - 30
        stbYhdzcx.Width = Me.ScaleWidth - 2 * stbYhdzcx.Left
        stbYhdzcx.Height = Me.ScaleHeight - stbYhdzcx.Top - fraInfo.Height - 30
        mfgYhdzd.Width = stbYhdzcx.Width - 30
        mfgYhdzd.Height = stbYhdzcx.Height - mfgYhdzd.Top
        mfgDwrjz.Width = stbYhdzcx.Width - 30
        mfgDwrjz.Height = stbYhdzcx.Height - mfgDwrjz.Top
        fraInfo.Left = Me.ScaleWidth - fraInfo.Width - 30