frmac_generalselectprint.frm

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

                ubHappen = True
                Cllr.SetCellDouble COL_CREDIT_MONEY, i, Cllr.GetCurSheet, dCredit_Money
            End If
                Cllr.SetCellString COL_DIRECTION, i, Cllr.GetCurSheet, sDireciton
            If Abs(dBalance_Amount) > 0.0001 Then
                Cllr.SetCellDouble COL_BALANCE_AMOUNT, i, Cllr.GetCurSheet, dBalance_Amount
            End If
            If Abs(dBalance_Foreign) > 0.0001 Then
                Cllr.SetCellDouble COL_BALANCE_FOREIGN, i, Cllr.GetCurSheet, dBalance_Foreign
            End If
            If Abs(dBalance_Money) > 0.0001 Then
                Cllr.SetCellDouble COL_BALANCE_MONEY, i, Cllr.GetCurSheet, Abs(dBalance_Money)
            End If
                
                '求本期累计
                i = i + 1
                dDebit_Amount = .Fields("ljjsl" & Format(k, "00")).value - .Fields("ljjsl00").value
                dDebit_Foreign = .Fields("ljjwb" & Format(k, "00")).value - .Fields("ljjwb00").value
                dDebit_Money = .Fields("ljj" & Format(k, "00")).value - .Fields("ljj00").value
                
                dCredit_Amount = .Fields("ljdsl" & Format(k, "00")).value - .Fields("ljdsl00").value
                dCredit_Foreign = .Fields("ljdwb" & Format(k, "00")).value - .Fields("ljdwb00").value
                dCredit_Money = .Fields("ljd" & Format(k, "00")).value - .Fields("ljd00").value
                
                dBalance_Money = .Fields("ljj" & Format(k, "00")).value - _
                        .Fields("ljd" & Format(k, "00")).value
                        
                If dBalance_Money > 0 Then
                    sDireciton = "借"
                ElseIf dBalance_Money = 0 Then
                    sDireciton = "平"
                Else
                    sDireciton = "贷"
                    dBalance_Amount = -dBalance_Amount
                    dBalance_Foreign = -dBalance_Foreign
                End If
                
                Cllr.SetCellString COL_MONTH, i, Cllr.GetCurSheet, k
                Cllr.SetCellString COL_SUMMARY, i, Cllr.GetCurSheet, "[ 本  年  累  计 ]"
            If Abs(dDebit_Amount) > 0.0001 Then
                Cllr.SetCellDouble COL_DEBIT_AMOUNT, i, Cllr.GetCurSheet, dDebit_Amount
            End If
            If Abs(dDebit_Foreign) > 0.0001 Then
                Cllr.SetCellDouble COL_DEBIT_FOREIGN, i, Cllr.GetCurSheet, dDebit_Foreign
            End If
            If Abs(dDebit_Money) > 0.0001 Then
                Cllr.SetCellDouble COL_DEBIT_MONEY, i, Cllr.GetCurSheet, dDebit_Money
            End If
            If Abs(dCredit_Amount) > 0.0001 Then
                Cllr.SetCellDouble COL_CREDIT_AMOUNT, i, Cllr.GetCurSheet, dCredit_Amount
            End If
            If Abs(dCredit_Foreign) > 0.0001 Then
                Cllr.SetCellDouble COL_CREDIT_FOREIGN, i, Cllr.GetCurSheet, dCredit_Foreign
            End If
            If Abs(dCredit_Money) > 0.0001 Then
                Cllr.SetCellDouble COL_CREDIT_MONEY, i, Cllr.GetCurSheet, dCredit_Money
            End If
                Cllr.SetCellString COL_DIRECTION, i, Cllr.GetCurSheet, sDireciton
            If Abs(dBalance_Amount) > 0.0001 Then
                Cllr.SetCellDouble COL_BALANCE_AMOUNT, i, Cllr.GetCurSheet, dBalance_Amount
            End If
            If Abs(dBalance_Foreign) > 0.0001 Then
                Cllr.SetCellDouble COL_BALANCE_FOREIGN, i, Cllr.GetCurSheet, dBalance_Foreign
            End If
            If Abs(dBalance_Money) > 0.0001 Then
                Cllr.SetCellDouble COL_BALANCE_MONEY, i, Cllr.GetCurSheet, Abs(dBalance_Money)
            End If
            Next k
            .Close
            Call SetGrid(iPageStart)
            iPageStart = iPageStart + 1
            ShowResult = iPageStart
            Screen.MousePointer = vbDefault
           
        End If
    End With

End Function

'从凭证表中求出会计期间等于(结账月份+1)的已记账凭证的记录数;
'如果iToMonth = 0 则判断年初1月份已记账凭证的记录数;
Private Function GetToMonth(ByVal iToMonth As Integer) As Integer
    Dim rstTemp As ADODB.Recordset
    
    Set rstTemp = New ADODB.Recordset
    With rstTemp
        .CursorLocation = adUseClient
        .Open "SELECT COUNT(*) iCount FROM tZW_Pzsj" & glo.sOperateYear & _
                " WHERE kjqj = " & iToMonth + 1 & " AND xgbz='2'", _
                glo.cnnMain, adOpenStatic, adLockReadOnly
        If .Fields("iCount").value = 0 Then
            GetToMonth = iToMonth
        Else
            GetToMonth = iToMonth + 1
        End If
    End With

End Function

'根据选择的账页格式重画表格的页头
Private Sub DoRedrawCellHead(ByVal iColWidth As Variant, _
                            ByVal Col_Debit_Start As Integer, ByVal Col_Debit_End As Integer, _
                            ByVal Col_Credit_Start As Integer, ByVal Col_Credit_End As Integer, _
                            ByVal Col_Balance_Start As Integer, ByVal COL_BALANCE_END As Integer, _
                            ByVal Row_Start As Integer, ByVal Row_End As Integer)
    Dim iTotalPages As Integer
    Dim lCurrentPage As Long
    Dim i As Integer
    Dim j As Integer
    
    With Cllr
        iTotalPages = .GetTotalSheets
        lCurrentPage = .GetCurSheet
        For i = 0 To iTotalPages
            .SetCurSheet i
            For j = LBound(iColWidth) To UBound(iColWidth)
                .SetColWidth 1, iColWidth(j), j, i
            Next j
            
            .MergeCells Col_Debit_Start, Row_Start, Col_Debit_End, Row_End
            .MergeCells Col_Credit_Start, Row_Start, Col_Credit_End, Row_End
            .MergeCells Col_Balance_Start, Row_Start, COL_BALANCE_END, Row_End
            
            .SetCellString Col_Debit_Start, ROW_HEAD1, i, "借方"
            .SetCellString Col_Credit_Start, ROW_HEAD1, i, "贷方"
            .SetCellString Col_Balance_Start, ROW_HEAD1, i, "余额"
            .SetCellString COL_DEBIT_AMOUNT, ROW_HEAD2, i, "数量"
            .SetCellString COL_DEBIT_FOREIGN, ROW_HEAD2, i, "外币"
            .SetCellString COL_DEBIT_MONEY, ROW_HEAD2, i, "金额"
            .SetCellString COL_CREDIT_AMOUNT, ROW_HEAD2, i, "数量"
            .SetCellString COL_CREDIT_FOREIGN, ROW_HEAD2, i, "外币"
            .SetCellString COL_CREDIT_MONEY, ROW_HEAD2, i, "金额"
            .SetCellString COL_BALANCE_AMOUNT, ROW_HEAD2, i, "数量"
            .SetCellString COL_BALANCE_FOREIGN, ROW_HEAD2, i, "外币"
            .SetCellString COL_BALANCE_MONEY, ROW_HEAD2, i, "金额"
        Next i
        .SetCurSheet lCurrentPage
    End With
End Sub
Private Sub SetGrid(ByVal iPageStart As Integer)
    Dim i As Long
    
    With Cllr
    'Draw Line
        .DrawGridLine COL_START, ROW_HEAD1, COL_END, .GetRows(.GetCurSheet) - 1, 1, 3, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_MONTH, ROW_HEAD1, COL_END, .GetRows(.GetCurSheet) - 2, 5, 2, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_DAY, ROW_HEAD1, COL_END, .GetRows(.GetCurSheet) - 1, 2, 2, .FindColorIndex(RGB(0, 0, 0), 1)
        
        .SetRows .GetRows(.GetCurSheet) + 1, .GetCurSheet
        i = .GetRows(.GetCurSheet) - 1
        Dim rowIndex As Long
        Dim colIndex As Long
        For rowIndex = ROW_GRID_START To i
            For colIndex = COL_START To COL_END
                .SetCellFont colIndex, rowIndex, .GetCurSheet, .FindFontIndex("宋体", 1)
                .SetCellFontSize colIndex, rowIndex, .GetCurSheet, 11
                .SetCellFontStyle colIndex, rowIndex, .GetCurSheet, 0
            Next
            .SetRowHeight 0, 63.2, rowIndex, .GetCurSheet
        Next
        '合并到单元格"借方外币"是由于当借方外币列宽为零时,打印预览会不显示打印日期;
        .MergeCells COL_START, i, COL_DEBIT_FOREIGN, i
        .MergeCells COL_DEBIT_MONEY, i, COL_END, i
        .MergeCells COL_START, ROW_SUBJNAME, COL_BALANCE_MONEY - 1, ROW_SUBJNAME
        .MergeCells COL_BALANCE_MONEY, ROW_SUBJNAME, COL_END, ROW_SUBJNAME
        .SetCellAlign COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, 35
        .s COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, "总    页 第 " + CStr(.GetCurSheet + 1 + iPageStart) + " 页"
        .SetCellFont COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, 10
        .SetCellFontStyle COL_BALANCE_MONEY, ROW_SUBJNAME, .GetCurSheet, 0
        
        .SetCellAlign COL_START, i, .GetCurSheet, 33
        .SetCellAlign COL_DEBIT_MONEY, i, .GetCurSheet, 34
        .SetCellFont COL_START, i, .GetCurSheet, .FindFontIndex("宋体", 1)
        .SetCellFontSize COL_START, i, .GetCurSheet, 10
        .SetCellFontStyle COL_START, i, .GetCurSheet, 0

        .SetCellFont COL_DEBIT_MONEY, i, .GetCurSheet, .FindFontIndex("宋体", 1)
        .SetCellFontSize COL_DEBIT_MONEY, i, .GetCurSheet, 10
        .SetCellFontStyle COL_DEBIT_MONEY, i, .GetCurSheet, 0
        .SetCellString COL_START, i, .GetCurSheet, "核算单位：" & m_sEnterName
        .SetCellString COL_DEBIT_MONEY, i, .GetCurSheet, "( 打印日期：" & Format(Date, "yyyy-mm-dd") & _
                    "    时间：" & Format(Time, "hh:MM:ss") & " )"
        .ShowPageBreak False
    End With
    
End Sub

'得到最大级次
Private Function uGetMaxJc() As String
   Dim adoTemp As ADODB.Recordset
    
   Set adoTemp = New ADODB.Recordset
   With adoTemp
       .CursorLocation = adUseClient
       .Open "SELECT max(kmjc) as maxkmjc FROM tZW_Km" & glo.sOperateYear, glo.cnnMain, adOpenStatic, adLockReadOnly
       uGetMaxJc = .Fields("maxkmjc").value
   End With
   Set adoTemp = Nothing
End Function
Private Sub GetDetailKm(stempcode As String)
  '根据查询科目求出该科目的所有最明细子科目

    Dim adoRstTemp As ADODB.Recordset
    Dim i As Integer
    Dim s_sql As String
    
    Set adoRstTemp = New ADODB.Recordset
    If ChkMj.value <> 1 Then
        If chkEndLevelSubject.value = 1 Then
            s_sql = "SELECT kmdm,kmmc FROM tZW_Km" & glo.sOperateYear & _
                    " WHERE kmdm LIKE '" & stempcode & "%' and  IsEndkm='-1'" & _
                    "  order by kmdm"
        Else
            s_sql = "SELECT kmdm,kmmc FROM tZW_Km" & glo.sOperateYear & _
                    " WHERE kmdm LIKE '" & stempcode & "%'" & _
                    "  order by kmdm"
        End If
    Else
        If chkEndLevelSubject.value = 1 Then
            s_sql = "SELECT kmdm,kmmc FROM tZW_Km" & glo.sOperateYear & _
                " WHERE kmdm LIKE '" & stempcode & "%'" & _
                " and ((kmjc>=" + CStr(updJcFrom.value) + " and kmjc <=" + CStr(updJcTo.value) + _
                  " and  IsEndkm='-1') or kmjc=" + CStr(updJcTo.value) + ")" & _
                  "   order by kmdm"
        Else
            s_sql = "SELECT kmdm,kmmc FROM tZW_Km" & glo.sOperateYear & _
                     " WHERE kmdm LIKE '" & stempcode & "%'" & _
                     " AND kmjc between '" & m_sJsStart & "' and '" & m_sJsEnd & "'   order by kmdm"
        End If
    End If

    With adoRstTemp
        .CursorLocation = adUseClient
        If Trim(stempcode) <> "" Then
         .Open s_sql, glo.cnnMain, adOpenStatic, adLockReadOnly
        Else
           Set adoRstTemp = Nothing
           bDetailFlag = False
           Exit Sub
        End If
        If .RecordCount = 0 Then
           Set adoRstTemp = Nothing
           bDetailFlag = False
           Exit Sub
        End If
        
        bDetailFlag = True
        ReDim arySubject(1 To .RecordCount)
        i = 0
        Do Until .EOF
            i = i + 1
            arySubject(i).sSubjectCode = Trim$(.Fields("kmdm").value)
            arySubject(i).sSubjectName = Trim$(.Fields("kmmc").value)
            .MoveNext
        Loop
        .Close
    End With
    Set adoRstTemp = Nothing
        
End Sub
Private Sub GetFKm(sStart As String, sEnd As String)
    Dim adoRstTemp As ADODB.Recordset
    Dim i As Integer

    Set adoRstTemp = New ADODB.Recordset
    With adoRstTemp
        .CursorLocation = adUseClient
        .Open "SELECT kmdm,kmmc FROM tZW_Km" & glo.sOperateYear & _
                " WHERE kmdm between'" & sStart & "' and '" & sEnd & _
                "' AND kmjc = 1 order by kmdm", _
            glo.cnnMain, adOpenStatic, adLockReadOnly
        
        ReDim sFirstLevel(1 To .RecordCount)
        i = 0
        Do Until .EOF
            i = i + 1
            sFirstLevel(i).sSubjectName = Trim$(.Fields("kmmc").value)
            sFirstLevel(i).sSubjectCode = Trim$(.Fields("kmdm").value)
            .MoveNext
        Loop
        .Close
    End With
    Set adoRstTemp = Nothing

End Sub

Public Function uiColWidth() As Integer()
    uiColWidth = m_iColWidth()
End Function

Private Sub UpdJcFrom_DownClick()
   If Val(txtJcFrom.text) > 1 Then
      txtJcFrom.text = Val(txtJcFrom) - 1
   Else
      txtJcFrom.text = 1
   End If
End Sub

Private Sub UpdJcFrom_UpClick()
If Val(txtJcFrom.text) < Val(txtJcTo.text) Then
      txtJcFrom.text = Val(txtJcFrom.text) + 1
 Else
      txtJcFrom.text = Val(txtJcTo.text)
 End If
End Sub

Private Sub updJcTo_DownClick()
    If Val(txtJcTo.text) > Val(txtJcFrom.text) Then
         txtJcTo.text = Val(txtJcTo.text) - 1
    Else
         txtJcTo.text = Val(txtJcTo.text)
    End If
End Sub

Private Sub updJcTo_UpClick()
   If Val(txtJcTo.text) < updJcTo.Max Then
         txtJcTo.text = Val(txtJcTo.text) + 1
     Else
        txtJcTo.text = updJcTo.Max
    End If
End Sub


'账页格式被改变时触发
Private Sub cboAccountFormat_Click