frmdprntj.frm

财务信息管理系统,适合做毕业论文的人使用

    If KeyCode = 113 Then    'F2
        View_Calendar Me, Editrq(Index), 0
    End If
    isEnt = True
End Sub

Private Sub Editrq_LostFocus(Index As Integer)
    If Editrq(Index).Text <> "" And isEnt Then
        Editrq(Index).Text = ForDate(Editrq(Index).Text)
        If IsDate(Editrq(Index).Text) Then
            Editrq(Index).Text = Format(Editrq(Index).Text, "yyyy-mm-dd")
        Else
            Beep
            MsgBox "日期非法，请检查！", vbCritical, zjGl_Name
            SetTxtFocus Editrq(Index)
            isEnt = False
        End If
    End If
End Sub

Private Sub Form_Load()
    Screen.MousePointer = vbHourglass
    Dim rsTcls As New UfRecordset
    CenterForm Me
    Me.Icon = LoadResPicture(109, vbResIcon)
    Me.Caption = "单据打印"
    cmdrq(0).Picture = LoadResPicture(1108, vbResBitmap)
    cmdrq(1).Picture = LoadResPicture(1108, vbResBitmap)
    Frame1.Caption = "请输入打印条件"
    cmdfind.Picture = LoadResPicture(103, vbResBitmap)
    cmdcancel.Picture = LoadResPicture(104, vbResBitmap)
    Label1(0).Caption = "起始时间"
    Label1(1).Caption = "业务编号"
    Label1(2).Caption = "单据类型"
    Label1(3).Caption = "是否包含未记账"
    Set rsTcls = dbsZJ.OpenRecordset("select * from FD_class order by csign", dbOpenSnapshot)
    With rsTcls
        .MoveFirst
        Do While Not .EOF
            Combo1.AddItem ![ctext]
            .MoveNext
        Loop
        .oClose
    End With
    Combo1.AddItem "催款单"
    Combo1.Text = Combo1.List(0)
    isEnt = True
    Screen.MousePointer = vbDefault
End Sub

' 条件合法性检查
Private Function Contquit() As Boolean
    Contquit = True
    
    If Editrq(0).Text <> "" Then
        Editrq(0).Text = ForDate(Editrq(0).Text)
        If Not IsDate(Editrq(0).Text) Then
            Beep
            MsgBox "日期非法，请检查！", vbCritical, zjGl_Name
            Contquit = False
            SetTxtFocus Editrq(0)
            Exit Function
        End If
    End If
    
    If Editrq(1) <> "" Then
        Editrq(1).Text = ForDate(Editrq(1).Text)
        If IsDate(Editrq(1).Text) Then
            If Editrq(0).Text <> "" Then
                If CDate(Editrq(1).Text) < CDate(Editrq(0).Text) Then
                    Beep
                    MsgBox "日期范围错误，请检查！", vbCritical, zjGl_Name
                    Contquit = False
                    SetTxtFocus Editrq(1)
                    Exit Function
                End If
            End If
        Else
            Beep
            MsgBox "日期非法，请检查！", vbCritical, zjGl_Name
            Contquit = False
            SetTxtFocus Editrq(1)
            Exit Function
        End If
    End If
    
    If Editbh(0).Text <> "" Then
        Editbh(0).Text = right("0000000000" & Editbh(0).Text, 10)
    End If
    
    If Editbh(1).Text <> "" Then
        Editbh(1).Text = right("0000000000" & Editbh(1).Text, 10)
        If Editbh(0).Text <> "" Then
            If Editbh(1).Text < Editbh(0).Text Then
                Beep
                MsgBox "业务编号范围错误，请检查！", vbCritical, zjGl_Name
                SetTxtFocus Editbh(1)
                Exit Function
            End If
        End If
    End If
    
    Dim i As Integer
    For i = 1 To Combo1.ListCount
        If Combo1.Text = Combo1.List(i - 1) Then
            ywzl = right(str(100 + i), 2)
            Exit For
        End If
    Next
    
End Function

Private Sub Cond_zh()
    Dim djID As String
    tjzh = "Select * from "
    Select Case ywzl
        Case Is = "01"
            tjzh = tjzh & "FD_Sav"
            djID = "[cSavID]"
        Case Is = "02"
            tjzh = tjzh & "FD_Fetch"
            djID = "[cFetID]"
        Case Is = "03"
            tjzh = tjzh & "FD_Sav"
            djID = "[cSavID]"
        Case Is = "04"
            tjzh = tjzh & "FD_Fetch"
            djID = "[cFetID]"
        Case Is = "05"
            tjzh = tjzh & "FD_Cred"
            djID = "[cCreID]"
        Case Is = "06"
            tjzh = tjzh & "FD_Cred"
            djID = "[cCreID]"
        Case Is = "07"
            tjzh = tjzh & "FD_UnwDeb"
            djID = "[cUnwID]"
        Case Is = "08"
            tjzh = tjzh & "FD_Return"
            djID = "[cRetID]"
        Case Is = "09"
            tjzh = tjzh & "FD_Return"
            djID = "[cRetID]"
        Case Is = "10"
            tjzh = tjzh & "FD_CreAcrRcp"
            djID = "[cCraID]"
        Case Is = "11"
            tjzh = tjzh & "FD_CreAcrRcp"
            djID = "[cCraID]"
        Case Is = "12"
            tjzh = tjzh & "FD_UnwRet"
            djID = "[cRetID]"
        Case Is = "13"
            tjzh = tjzh & "FD_UnwAcrRcp"
            djID = "[cUnaID]"
        Case Is = "14"
            tjzh = tjzh & "FD_SettAcc"
            djID = "[cSetID]"
        Case Is = "15"
            tjzh = tjzh & "FD_SettAcc"
            djID = "[cSetID]"
        Case Is = "16"
            tjzh = tjzh & "FD_CadAcr"
            djID = "[cCarID]"
        Case Is = "17"
            tjzh = tjzh & "FD_Hasten"
            djID = "[cHid]"
    End Select
    
    If ywzl = 17 Then
        tjzh = tjzh & " Where " & djID & " like '000%'"
        If Editbh(0).Text <> "" Then
            tjzh = tjzh & " And " & djID & " >= '" & Editbh(0).Text & "'"
        End If
        If Editbh(1).Text <> "" Then
            tjzh = tjzh & " And " & djID & " <= '" & Editbh(1).Text & "'"
        End If
        If Editrq(0).Text <> "" Then
            tjzh = tjzh & " And [dBeday] >= '" & Editrq(0).Text & "'"
        End If
        If Editrq(1).Text <> "" Then
            tjzh = tjzh & " And [dBeday] <= '" & Editrq(1).Text & "'"
        End If
        tjzh = tjzh & " Order by " & djID
    Else
        tjzh = tjzh & " Where " & djID & " like '" & ywzl & "%'"
        If Check1.Value = 0 Then
            tjzh = tjzh & " and (not ([cBookCode] is null))"
        End If
        If Editbh(0).Text <> "" Then
            tjzh = tjzh & " And " & djID & " >= '" & ywzl & Editbh(0).Text & "'"
        End If
        If Editbh(1).Text <> "" Then
            tjzh = tjzh & " And " & djID & " <= '" & ywzl & Editbh(1).Text & "'"
        End If
        If Editrq(0).Text <> "" Then
            tjzh = tjzh & " And [dbill_date] >= '" & Editrq(0).Text & "'"
        End If
        If Editrq(1).Text <> "" Then
            tjzh = tjzh & " And [dbill_date] <= '" & Editrq(1).Text & "'"
        End If
        tjzh = tjzh & " Order by " & djID
    End If
End Sub

Private Sub label1_Click(Index As Integer)
    If Index = 3 Then
        Check1.Value = 1 - Check1.Value
    End If
End Sub

Private Sub Docuprn()
    On Error GoTo err1
    
    Dim djzs As Integer, i As Integer, dJm As String, Lp1 As Long, Lp2 As Long, Retv As Long, PaperName As String
    Lp1 = 1
    
    Set rsTprn = dbsZJ.OpenRecordset(tjzh, dbOpenSnapshot)
    With rsTprn
        If .EOF Then
            .oClose
            Exit Sub
        End If
        .MoveLast
        .MoveFirst
        djzs = .RecordCount
    End With
    
    If ywzl = "17" Then
        UfGridADO1.Redraw = False
        UfGridADO1.FixedCols = 0
    
        UfGridADO1.Cols = 5
        UfGridADO1.ColWidth(0) = 2100
        UfGridADO1.ColWidth(1) = 2100
        UfGridADO1.ColWidth(2) = 1200
        UfGridADO1.ColWidth(3) = 1200
        UfGridADO1.ColWidth(4) = 3000
    
        UfGridADO1.Rows = 2
        UfGridADO1.FixedRows = 2
    
        With Me.UfGridADO1
            .TextMatrix(0, 0) = "开始日期"
            .JoinCells 0, 0, 1, 0, True
            .ColAlignment(0) = UG_ALIGNCENTER
        
            .TextMatrix(0, 1) = "结束日期"
            .JoinCells 0, 1, 1, 1, True
            .ColAlignment(1) = UG_ALIGNCENTER
        
            .TextMatrix(0, 2) = "利率"
            .TextMatrix(1, 2) = "（%）"
            .ColAlignment(2) = UG_ALIGNRIGHT
        
            .TextMatrix(0, 3) = "天数"
            .ColAlignment(3) = UG_ALIGNRIGHT
            .JoinCells 0, 3, 1, 3, True
        
            .TextMatrix(0, 4) = "结欠利息"
            .JoinCells 0, 4, 1, 4, True
            .ColAlignment(4) = UG_ALIGNRIGHT
                
            .HeadFont.Name = "宋体"
            .HeadFont.Size = 9
            .HeadFont.Bold = True
        End With
        
        dJm = "cuikdj"
        WgetPaper dJm
        If ZjAccInfo.zjPrnSetPager = 256 Then
            Lp2 = 1
        Else
            Lp2 = 0
        End If
        
        With Me.RTPrn1
            .lngrtpType = enmrtpAccount
            .strrtpTitleTempletFile = ZjAccInfo.zjRepPath & ZjAccInfo.zjPrnbtRepName
            .strrtpTitleTempTable = "Print"
            .strrtpTailTempletFile = ZjAccInfo.zjRepPath & ZjAccInfo.zjPrnbwRepName
            .strrtpTailTempTable = "print1"
            .strrtpTempBase = ZjAccInfo.zjTempPath & ZjAccInfo.zjTempDB
            .lngrtpPaperSize = ZjAccInfo.zjPrnSetPager
            .lngrtpPaperOrient = IIf(ZjAccInfo.zjPrnSetFx, 1, 0)
            If ZjAccInfo.zjPrnSetPager = 256 Then
                .rtpSetSelfDefPaper ZjAccInfo.zjPaperWidth, ZjAccInfo.zjPaperHight
            End If
            Set .objrtpBodyGrid = Me.UfGridADO1
            .brtpUseSetupDialog = False
            Retv = .rtpPageSetup(Lp1, Lp2, PaperName)
        End With
        If Retv = -1 Or (Retv Mod 65536) > 1000 Then GoTo err1
        
        Do While Not rsTprn.EOF
            If PreCkDocuData(rsTprn![cHid]) Then