frmyh_yhdzwd.frm

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

Dim aKmdm() As String                       '存放银行对账的科目
Dim oldKmdmListIndex As Integer             '上一次的科目代码列表框的行索引号
Dim oldViewListIndex As Integer             '上一次显示条件的行索引号
Dim KmdmSelect As String                    '当前选中的科目代码
Dim sQueryStr As String                     '查询条件字符串
Dim bFormload As Boolean                    '当前是否在窗体的引导状态
Dim bTheSameYear As String                  '0 -- 注册年份小于银行对账启用年份
                                            '1 -- 注册年份等于银行对账启用年份
                                            '2 -- 注册年份大于银行对账启用年份
Dim JzRq As Date
Dim Cgts As Integer

Private Sub MakeSql(ByVal s As String)
Set rstTemp = New ADODB.Recordset
rstTemp.CursorLocation = adUseClient
sSQL = "SELECT * FROM tZW_Yhdzqyrq"
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

Dim Temprq As String
If s = "(全部)" Then s = ""
Temprq = Format(DateAdd("d", -CDbl(Cgts), JzRq), "yyyy-mm-dd")
sSQLYhdzd = "SELECT a.*,b.kmmc,b.wbdw FROM tZW_Yhdzd" & glo.sOperateYear & _
       " a,tzw_km" & glo.sOperateYear & " b WHERE a.kmdm=b.kmdm And a.kmdm like '" + s + "%' and rq<= " _
       + GetDateTimeString(g_FLAT, CDate(Temprq), "00:00:00") + _
       " AND qcbz <> 0 AND hxbz = 0 AND ( lqbz is null)  ORDER BY rq,jsfsCode,Bill"
       
'如果当前注册年份和银行对账启用年份相同
sQueryStr = ""
If bTheSameYear = 1 Then
    sQueryStr = " WHERE pzrq<=" + GetDateTimeString(g_FLAT, CDate(Temprq), "00:00:00") + _
        " and pzrq>=" + GetDateTimeString(g_FLAT, CDate(Yhdzqyrq), "00:00:00") + _
        " AND ((kjqj >= " & Month(CDate(Yhdzqyrq)) & _
        " AND kjqj <= 12)" & " OR kjqj = 21)" & _
        " AND (yhdz_lqbz=0 or yhdz_lqbz is null)" & _
        " AND yhdz_hxbz = 0" & _
        " AND a.Kmdm =b.Kmdm" & _
        " AND b.IsYhz=-1 And a.kmdm like '" + s + "%'"
ElseIf bTheSameYear = 2 Then
    sQueryStr = " WHERE pzrq<=" + GetDateTimeString(g_FLAT, CDate(Temprq), "00:00:00") + _
    " AND ((kjqj >= 1 AND kjqj <= 12)" & " OR kjqj = 21)" & _
    " AND yhdz_hxbz = 0 and (yhdz_lqbz=0 or yhdz_lqbz is null)" & _
    " AND a.Kmdm =b.Kmdm" & _
    " AND b.IsYhz=-1 And a.kmdm like '" + s + "%'"
End If

sSQLDwrjz = "SELECT a.kmdm,a.kmmc,pzzl,pzbh,pzrq,pzzy,fx,je,yhdz_jsfscode," & _
            "yhdz_bill,yhdz_date,b.wbdw,a.wb" & _
            " FROM tZW_Pzsj" & glo.sOperateYear & " a, tZW_Km" & glo.sOperateYear & " b " & sQueryStr & _
            " ORDER BY pzrq"

End Sub

Private Sub cboFilter_Click()
MakeSql cboFilter.text
Call SetHead
Call FillGridYhdzd(sSQLYhdzd)
Call FillGridDwrjz(sSQLDwrjz)
End Sub

Private Sub form_load()
Dim rSt As New ADODB.Recordset

'Dim rq As Date
rSt.Open "Select * from tZW_KM" + glo.sOperateYear + "  where isyhz=-1", glo.cnnMain, adOpenDynamic, adLockOptimistic
cboFilter.Clear
cboFilter.AddItem "(全部)"
While rSt.EOF = False
    cboFilter.AddItem rSt.Fields("Kmdm").value
    rSt.MoveNext
Wend
rSt.Close
cboFilter.ListIndex = 0

Label3.Caption = JzRq
Label5.Caption = Cgts
MakeSql "(全部)"
Call SetHead
Call FillGridYhdzd(sSQLYhdzd)
Call FillGridDwrjz(sSQLDwrjz)
Me.MousePointer = vbDefault

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 Double
    
    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 .RecordCount <> 0 Then
                .MoveFirst
                iRow = 0
                For i = 1 To .RecordCount
                    If FormatToDouble(.Fields("je").value) <> 0 And (FormatToDouble(.Fields("wb").value) <> 0 Or Trim(FormatToString(.Fields("wbdw").value)) = "") Then
                        iRow = iRow + 1
                        mfgDwrjz.AddItem iRow & vbTab & _
                                         Trim$("" & .Fields("kmdm").value) & vbTab & _
                                         Trim$("" & .Fields("kmmc").value) & vbTab & _
                                         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 & _
                                         Trim$("" & .Fields("fx").value) & vbTab & _
                                         Format(.Fields("je").value, "##,##0.00") & vbTab & _
                                         .Fields("pzzl").value & vbTab & _
                                         .Fields("pzbh").value & vbTab & _
                                         Trim$("" & .Fields("pzzy").value)
                        mfgDwrjz.row = iRow
                    End If
                    .MoveNext
                Next i
            End If
        End With
    End If
    mfgDwrjz.SelectionMode = flexSelectionByRow
    mfgDwrjz.ColAlignment(1) = flexAlignLeftCenter
    mfgDwrjz.ColAlignment(2) = flexAlignLeftCenter
    mfgDwrjz.ColAlignment(3) = flexAlignLeftCenter
    mfgDwrjz.ColAlignment(4) = flexAlignLeftCenter
    mfgDwrjz.ColAlignment(5) = flexAlignLeftCenter
    mfgDwrjz.ColAlignment(6) = flexAlignLeftCenter
    mfgDwrjz.ColAlignment(7) = flexAlignCenterCenter
    mfgDwrjz.ColAlignment(8) = flexAlignRightCenter
    mfgDwrjz.ColAlignment(9) = flexAlignLeftCenter
    mfgDwrjz.Refresh
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.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 i & vbTab & _
                                    Trim$("" & .Fields("kmdm").value) & vbTab & _
                                    Trim$("" & .Fields("kmmc").value) & vbTab & _
                                    CStr(Format(.Fields("rq").value, "yyyy-mm-dd")) & vbTab & _
                                    Trim$("" & .Fields("jsfsCode").value) + " " + GetJsfsName(Trim$("" & .Fields("jsfsCode").value)) & vbTab & _
                                    IIf(.Fields("bill").value = "++++", "", Trim$("" & .Fields("bill").value)) & vbTab & _
                                    Trim$("" & .Fields("fx").value) & vbTab & _
                                    Trim$("" & CStr(Format(.Fields("je").value, "##,##0.00")))
                        mfgYhdzd.row = i
                        For j = 0 To mfgYhdzd.Cols - 1
                            mfgYhdzd.col = j
                        Next j
                    .MoveNext
                Next i
                For j = 0 To mfgYhdzd.Cols - 1
                    mfgYhdzd.col = j
                Next j
            End If
        End With
    End If
    mfgYhdzd.SelectionMode = flexSelectionByRow
    mfgYhdzd.ColAlignment(0) = flexAlignLeftCenter
    mfgYhdzd.ColAlignment(1) = flexAlignLeftCenter
    mfgYhdzd.ColAlignment(2) = flexAlignLeftCenter
    mfgYhdzd.ColAlignment(3) = flexAlignLeftCenter
    mfgYhdzd.ColAlignment(4) = flexAlignLeftCenter
    mfgYhdzd.ColAlignment(5) = flexAlignLeftCenter
    mfgYhdzd.ColAlignment(6) = flexAlignCenterCenter
    mfgYhdzd.ColAlignment(7) = flexAlignRightCenter
    mfgYhdzd.Refresh
End Sub


'设置表头
Private Sub SetHead()
    With mfgYhdzd
        .ColWidth(0) = 400
        .ColWidth(1) = 2000
        .ColWidth(2) = 2000
        .ColWidth(3) = 1400
        .ColWidth(4) = 1500
        .ColWidth(5) = 1000
        .ColWidth(6) = 400
        .ColWidth(7) = 3000
        
        .ColAlignment(0) = 4
        .ColAlignment(1) = 4
        .ColAlignment(2) = 4
        .ColAlignment(3) = 7
        .ColAlignment(4) = 7
        .ColAlignment(5) = 4
        .ColAlignment(6) = 1
        .ColAlignment(7) = 1
        .row = 0
        .RowHeight(0) = 300
        For j = 0 To .Cols - 1
            .col = j
            .CellAlignment = 4
        Next j
    End With
    
    With mfgDwrjz
        .ColWidth(0) = 400
        .ColWidth(1) = 2000
        .ColWidth(2) = 2000
        .ColWidth(3) = 1400
        .ColWidth(4) = 1400
        .ColWidth(5) = 1500
        .ColWidth(6) = 1000
        .ColWidth(7) = 400
        .ColWidth(8) = 3000
        .ColWidth(9) = 800
        .ColWidth(10) = 600
        .ColWidth(11) = 3000
        
        .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
        .ColAlignment(10) = 1
        .ColAlignment(11) = 1
        .row = 0
        .RowHeight(0) = 300
        For j = 0 To .Cols - 1
            .col = j
            .CellAlignment = 4
        Next j
    End With
End Sub


Private Sub Form_Unload(Cancel As Integer)
 Cancel = 0
'    Unload frmP
    
End Sub

Private Sub mnubz_Click()
SendKeys "F1"
Exit Sub
End Sub

Private Sub mnudy_Click()
Call Operate("PRINT")
End Sub

Private Sub mnutc_Click()
Call Operate("EXIT")
End Sub

Private Sub mnuyl_Click()
Call Operate("PREVIEW")
End Sub

Private Sub tbrCxyhdz_ButtonClick(ByVal Button As MSComctlLib.Button)
Call Operate(UCase(Button.Key))
End Sub
Private Sub Operate(strKey As String)
    Select Case strKey
        Case "PRINT"
              Call ShowPrintResult("PRINT")
        Case "PREVIEW"
              Call ShowPrintResult("PREVIEW")
        Case "HELP"
            Call ShowHelp
        Case "EXIT"
            Unload Me
    End Select
End Sub
'显示打印结果
Private Sub ShowPrintResult(ByVal sPrtStr As String)
    If Printers.Count = 0 Then
       MsgBox "请安置打印机！", vbInformation
       Exit Sub
    Else
'    If IsChangeCurrentTable Then
'        Unload frmP
        IsChangeCurrentTable = False
        Call DrawCellTable
    End If
    
    Me.Hide
'    frmP.Show
    If sPrtStr = "PRINT" Then
       frmP.Cllr.Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
       frmP.uPrint
    Else
        frmP.Cllr.Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
        frmP.uPreview
    End If
    Me.Show 1
End Sub
'根据MSFLEXGRID表格生成CELL表格
Private Sub DrawCellTable()
    Dim sTitle As String
    Dim lPage As Long
    Dim lCount As Long
    Dim i As Long
    Dim j As Long
    
    Set frmP = New frmPrint
    Select Case stbYhdzcx.Tab
        Case 0
            With frmP.Cllr
                .ResetContent
                .SetCols COL_END_YH + 2, 0
                .SetRows ROW_GRID_START + ROWS_PAGE_YH, 0
            End With
        Case 1
            With frmP.Cllr
                .ResetContent
                .SetCols COL_END_DW + 2, 0
                .SetRows ROW_GRID_START + ROWS_PAGE_DW, 0
            End With
    End Select
  
    lPage = 0
    lCount = 0
     
    sTitle = "  科目代码：" + cboFilter.text