frmyh_yhdzcx.frm

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

        fraInfo.Top = Me.ScaleHeight - fraInfo.Height - 30
    End If
End Sub

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

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

Private Sub mnuFilter_Click()
    Call Operate("FILTER")
End Sub

Private Sub mnuHelp_Click()
    Call Operate("HELP")
End Sub

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

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

Private Sub stbYhdzcx_Click(PreviousTab As Integer)
    With stbYhdzcx
        If .Tab <> PreviousTab Then
            IsChangeCurrentTable = True
        End If
        If .Tab = 0 Then
            lblYhdzmc.Caption = "银行对账单"
        Else
            lblYhdzmc.Caption = "单位日记账"
        End If
    End With
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 "FILTER"
            IsChangeCurrentTable = True
            Call QueryConditionInput
        Case "HELP"
            Call ShowHelp
        Case "EXIT"
            Unload Me
    End Select
End Sub

'调用查询条件输入窗体
Private Sub QueryConditionInput()
    frmYH_Yhcxtj.Show 1
    Me.MousePointer = vbHourglass
    With frmYH_Yhcxtj
        If .IsOk Then
            If .chkNoFilter = 1 Then
                If stbYhdzcx.Tab = 0 Then
                    Call FillGridYhdzd(sSQLYhdzd)
                Else
                    Call FillGridDwrjz(sSQLDwrjz)
                End If
                .chkNoFilter = 0
            Else
                If stbYhdzcx.Tab = 0 Then
                    Call FillGridYhdzd(GetQueryStrYhdzd)
                Else
                    Call FillGridDwrjz(GetQueryStrDwrjz)
                End If
            End If
        Else
            If .chkNoFilter = 1 Then
                .chkNoFilter = 0
            End If
        End If
    End With
    Me.MousePointer = vbDefault
End Sub

'从"frmYH_yhcxtj"查询条件窗体中得到银行对账单查询字符串
Private Function GetQueryStrYhdzd() As String
    With frmYH_Yhcxtj
        If .chkNoFilter.value = 0 Then
            GetQueryStrYhdzd = "SELECT * FROM tZW_yhdzd" & glo.sOperateYear & " WHERE "
            If .txtQsrq.text <> "____-__-__" Then
                Select Case g_FLAT
                    Case "SQL"
                        GetQueryStrYhdzd = GetQueryStrYhdzd & "rq >= '" & .txtQsrq.text & "' AND "
                    Case "ORACLE"
                        GetQueryStrYhdzd = GetQueryStrYhdzd & _
                                        "rq >= TO_DATE('" & .txtQsrq.text & "','YYYY-MM-DD') AND "
                End Select
            End If
            If .txtJsrq.text <> "____-__-__" Then
                Select Case g_FLAT
                    Case "SQL"
                        GetQueryStrYhdzd = GetQueryStrYhdzd & "rq <= '" & .txtJsrq.text & "' AND "
                    Case "ORACLE"
                        GetQueryStrYhdzd = GetQueryStrYhdzd & _
                                        "rq <= TO_DATE('" & .txtJsrq.text & "','YYYY-MM-DD') AND "
                End Select
            End If
            If .cboJsfs.text <> "" Then
                GetQueryStrYhdzd = GetQueryStrYhdzd & _
                    "jsfsCode = '" & Left(.cboJsfs.text, InStr(.cboJsfs.text, " ") - 1) & "' AND "
            End If
            If .txtBill.text <> "" Then
                GetQueryStrYhdzd = GetQueryStrYhdzd & "bill = '" & .txtBill.text & "' AND "
            End If
            If .optJf.value Then
                GetQueryStrYhdzd = GetQueryStrYhdzd & "fx = '借' AND "
            ElseIf .optDf.value Then
                GetQueryStrYhdzd = GetQueryStrYhdzd & "fx = '贷' AND "
            End If
            If .txtQsje.text <> "" Then
                GetQueryStrYhdzd = GetQueryStrYhdzd & "je >= " & Val(Format(.txtQsje.text, "###0.00")) & " AND "
            End If
            If .txtJsje.text <> "" Then
                GetQueryStrYhdzd = GetQueryStrYhdzd & "je <= " & Val(Format(.txtJsje.text, "###0.00")) & " AND "
            End If
            GetQueryStrYhdzd = GetQueryStrYhdzd & "kmdm = '" & KmdmSelect & GetYdzStr & " ORDER BY rq,jsfsCode,Bill"
        End If
    End With
End Function

'从"frmYH_yhcxtj"查询条件窗体中得到单位日记账查询字符串
Private Function GetQueryStrDwrjz() As String
    With frmYH_Yhcxtj
        If .chkNoFilter.value = 0 Then
            GetQueryStrDwrjz = "SELECT pzzl,pzbh,pzrq,pzzy,fx,je,yhdz_jsfscode," & _
                                "yhdz_bill,yhdz_date,yhdz_lqbz" & _
                                " FROM tZW_Pzsj" & glo.sOperateYear & " WHERE "
 
            If .txtQsrq.text <> "____-__-__" Then
                Select Case g_FLAT
                    Case "SQL"
                        GetQueryStrDwrjz = GetQueryStrDwrjz & "pzrq >= '" & .txtQsrq.text & "' AND "
                    Case "ORACLE"
                        GetQueryStrDwrjz = GetQueryStrDwrjz & _
                                        "pzrq >= TO_DATE('" & .txtQsrq.text & "','YYYY-MM-DD') AND "
                End Select
            End If
            If .txtJsrq.text <> "____-__-__" Then
                Select Case g_FLAT
                    Case "SQL"
                        GetQueryStrDwrjz = GetQueryStrDwrjz & "pzrq <= '" & .txtJsrq.text & "' AND "
                    Case "ORACLE"
                        GetQueryStrDwrjz = GetQueryStrDwrjz & _
                                        "pzrq <= TO_DATE('" & .txtJsrq.text & "','YYYY-MM-DD') AND "
                End Select
            End If
            If .cboJsfs.text <> "" Then
                GetQueryStrDwrjz = GetQueryStrDwrjz & _
                    "yhdz_jsfsCode = '" & Left(.cboJsfs.text, InStr(.cboJsfs.text, " ") - 1) & "' AND "
            End If
            If .txtBill.text <> "" Then
                GetQueryStrDwrjz = GetQueryStrDwrjz & "yhdz_bill = '" & .txtBill.text & "' AND "
            End If
            If .optJf.value Then
                GetQueryStrDwrjz = GetQueryStrDwrjz & "fx = '借' AND "
            ElseIf .optDf.value Then
                GetQueryStrDwrjz = GetQueryStrDwrjz & "fx = '贷' AND "
            End If
            If .txtQsje.text <> "" Then
                GetQueryStrDwrjz = GetQueryStrDwrjz & "je >= " & Val(Format(.txtQsje.text, "###0.00")) & " AND "
            End If
            If .txtJsje.text <> "" Then
                GetQueryStrDwrjz = GetQueryStrDwrjz & "je <= " & Val(Format(.txtJsje.text, "###0.00")) & " AND "
            End If
            GetQueryStrDwrjz = GetQueryStrDwrjz & "kmdm = '" & KmdmSelect & GetYdzStr & " ORDER BY pzrq"
        End If
    End With
End Function

'得到已达账查询子串
Private Function GetYdzStr() As String
    GetYdzStr = ""
    With cboViewselect
        If .text = "全部显示" Then
            If stbYhdzcx.Tab = 0 Then
                GetYdzStr = "' AND qcbz <> 0 AND hxbz = 0"
            Else
                If bTheSameYear = 1 Then
                    GetYdzStr = "' AND ((kjqj >= " & Month(CDate(Yhdzqyrq)) & _
                                " AND kjqj <= 12)" & " OR kjqj = 21)" & _
                                " AND yhdz_hxbz = 0"
                ElseIf bTheSameYear = 2 Then
                    GetYdzStr = "' AND ((kjqj >= 1 AND kjqj <= 12)" & " OR kjqj = 21)" & _
                                " AND yhdz_hxbz = 0"
                End If
            End If
        ElseIf .text = "显示已达账" Then
            If stbYhdzcx.Tab = 0 Then
                GetYdzStr = "' AND qcbz <> 0 AND lqbz > 0 AND hxbz = 0"
            Else
                If bTheSameYear = 1 Then
                    GetYdzStr = "' AND ((kjqj >= " & Month(CDate(Yhdzqyrq)) & _
                                " AND kjqj <= 12)" & " OR kjqj = 21)" & _
                                " AND yhdz_lqbz > 0 AND yhdz_hxbz = 0"
                ElseIf bTheSameYear = 2 Then
                    GetYdzStr = "' AND ((kjqj >= 1 AND kjqj <= 12)" & " OR kjqj = 21)" & _
                                " AND yhdz_lqbz > 0 AND yhdz_hxbz = 0"
                End If
            End If
        Else
           '==========================8.17======yao==add===========================================
            If stbYhdzcx.Tab = 0 Then
                GetYdzStr = "' AND qcbz <> 0 AND (lqbz IS NULL) AND hxbz = 0"
            Else
                If bTheSameYear = 1 Then
                    GetYdzStr = "' AND ((kjqj >= " & Month(CDate(Yhdzqyrq)) & _
                                " AND kjqj <= 12)" & " OR kjqj = 21)" & _
                                " AND (yhdz_lqbz IS NULL) AND yhdz_hxbz = 0"
                ElseIf bTheSameYear = 2 Then
                    GetYdzStr = "' AND ((kjqj >= 1 AND kjqj <= 12)" & " OR kjqj = 21)" & _
                                " AND (yhdz_lqbz IS NULL) AND yhdz_hxbz = 0"
                End If
            End If
          '=======================================================================================
            
        End If
    End With
End Function

'设置打印银行对账单表格
Private Sub SetGrid_YH(ByVal PageNo As Long, ByVal sTitle As String, Optional ByVal FactRows As Long)
    Dim i As Long, j As Long
    Dim iColWidth() As Integer
    
    With frmP.Cllr
        .SetCurSheet PageNo - 1
        .SetRows FactRows, PageNo - 1
        .SetCols COL_END_YH + 2, PageNo - 1
        .PrintSetMargin 10, 10, 10, 10
        .ShowSideLabel 0, PageNo - 1
        .ShowTopLabel 0, PageNo - 1
        .SetDefaultFont .FindFontIndex("宋体", 1), 10
        
    'Title
        .SetCellAlign COL_START_YH, ROW_TITLE, PageNo - 1, 36
        .SetCellFont COL_START_YH, ROW_TITLE, PageNo - 1, .FindFontIndex("黑体", 1)
        .SetCellFontSize COL_START_YH, ROW_TITLE, PageNo - 1, 19
        .SetCellFontStyle COL_START_YH, ROW_TITLE, PageNo - 1, 10
        .MergeCells COL_START_YH, ROW_TITLE, COL_END_YH, ROW_TITLE
        .SetCellString COL_START_YH, ROW_TITLE, PageNo - 1, "银行对账单" & sTitle
        .SetRowHeight 1, 40, ROW_TITLE, PageNo - 1
    'Comment
        .MergeCells COL_START_YH, ROW_SUBJNAME, COL_DEBIT_MONEY_YH, ROW_SUBJNAME
        .MergeCells COL_CREDIT_MONEY_YH, ROW_SUBJNAME, COL_END_YH, ROW_SUBJNAME
       .SetCellFont COL_START_YH, ROW_SUBJNAME, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_START_YH, ROW_SUBJNAME, PageNo - 1, 10
        .SetCellFontStyle COL_START_YH, ROW_SUBJNAME, PageNo - 1, 0
        .SetCellAlign COL_CREDIT_MONEY_YH, ROW_SUBJNAME, PageNo - 1, 34
        .SetCellFont COL_CREDIT_MONEY_YH, ROW_SUBJNAME, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_CREDIT_MONEY_YH, ROW_SUBJNAME, PageNo - 1, 10
        .SetCellFontStyle COL_CREDIT_MONEY_YH, ROW_SUBJNAME, PageNo - 1, 0
        
        .SetCellString COL_START_YH, ROW_SUBJNAME, PageNo - 1, "银行科目：" & cboKmmc.List(cboKmmc.ListIndex)
        .SetCellString COL_CREDIT_MONEY_YH, ROW_SUBJNAME, PageNo - 1, "第 " & CStr(PageNo) & " 页"
    
    'Head
        For i = ROW_HEAD1 To ROW_HEAD1
            .SetRowHeight 1, 30, i, PageNo - 1
            For j = COL_START_YH To COL_END_YH
                .SetCellAlign j, i, PageNo - 1, 36
                .SetCellTextStyle j, i, PageNo - 1, 2
''                .DoSetCellFont j, i, 10, 0, "楷体_GB2312"
                .SetCellFont j, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
                .SetCellFontSize j, i, PageNo - 1, 10
                .SetCellFontStyle j, i, PageNo - 1, 0
            Next j
        Next i
        
        '设置列宽
        iColWidth = GetColWidth(COLWIDTH_YH)
        For i = LBound(iColWidth) To UBound(iColWidth)
            .SetColWidth 1, iColWidth(i), i + 1, PageNo - 1
        Next i
        .SetColWidth 1, 1, COL_END_YH + 1, PageNo - 1
        
        '设置内容
        .SetCellString COL_RQ, ROW_HEAD1, PageNo - 1, "日期"
        .SetCellString COL_JSFS_YH, ROW_HEAD1, PageNo - 1, "结算方式"
        .SetCellString COL_BILL_NUMBER_YH, ROW_HEAD1, PageNo - 1, "票号"
        .SetCellString COL_DEBIT_MONEY_YH, ROW_HEAD1, PageNo - 1, "借方金额"
        .SetCellString COL_CREDIT_MONEY_YH, ROW_HEAD1, PageNo - 1, "贷方金额"
        .SetCellString COL_LQBZ_YH, ROW_HEAD1, PageNo - 1, "两清标志"
        .SetCellString COL_ZY, ROW_HEAD1, PageNo - 1, "摘要"
    'Text
        For i = ROW_GRID_START To .GetRows(PageNo - 1) - 1
        .SetRowHeight 1, 20, i, PageNo - 1
            For j = COL_START_YH To COL_END_YH
             .SetCellFont j, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
             .SetCellFontSize j, i, PageNo - 1, 10