通知单打印.frm

用友U8财务软件VB源程序, 本版本为2002年版本

        .Buttons("exit").Enabled = True
        If rstLXadv.BOF Then
            .Buttons("PriorPage").Enabled = False
        Else
            .Buttons("PriorPage").Enabled = True
        End If
        If rstLXadv.EOF Then
            .Buttons("NextPage").Enabled = False
        Else
            .Buttons("NextPage").Enabled = True
        End If
        If bF Then
            .Buttons("FirstPage").Enabled = False
            .Buttons("LastPage").Enabled = True
        End If
        If bL Then
            .Buttons("FirstPage").Enabled = True
            .Buttons("LastPage").Enabled = False
        End If
        If bSave Then
            .Buttons("Modify").Enabled = False
        Else
            .Buttons("Modify").Enabled = True
        End If

      End If
   End With
   
End Sub

Public Sub Gen_Key(TLB_Key As String)
    Dim i           As Integer
    Dim scAccID     As String
    Dim sDbill_date As String
    Dim sdFrom      As String
    Dim sdTo        As String
    
    On Error Resume Next
    scAccID = rstLXadv![cAccId]
    sDbill_date = ForDate(rstLXadv![JCR])
    sdFrom = ForDate(rstLXadv![dFrom])
    sdTo = ForDate(rstLXadv![dTo])
    On Error GoTo 0
        
    Select Case TLB_Key
        Case "Set"
            wTabPrnPaperSet
        Case "Print", "Preview"
            If bSave Then SaveYN
            zjPrnViewOut Me, "lxtzd", TLB_Key
            
        Case "BatchPrn"
            If bSave Then SaveYN
            Set tzdPrns = New frmPprn
            tzdPrns.Show vbModal
            If prnAccID <> "" Then
                IniSQL
                On Error Resume Next
                With rstLXadv:
                    While Not .EOF
                        FrmRefresh
                        If blnPrn Then
                           zjPrnViewOut Me, "lxtzd", TLB_Key
                        End If
                        .MoveNext
                    Wend
                End With
                rstLXadv.MoveFirst
                FrmRefresh
                SetButtonStatus
                On Error GoTo 0
            Else
                blnPrn = False
                Exit Sub
            End If
            blnPrn = False
            
        Case "Seek"
            If bSave Then SaveYN
            frmlxadvice.Show vbModal
            
        Case "Modify"
            bSave = True
            With edtRemark:
               .Locked = False
               .SetFocus
               .SelStart = 0
               .SelText
            End With
            
        Case "Save"
            If bSave Then
                bSave = False
                If edtRemark = "" Then
                    dbsZJ.Execute "UPDATE FD_CadAcr SET FD_CadAcr.cRemark=Null " & _
                                  "WHERE (FD_CadAcr.cGAccID='" & scAccID & "' OR FD_CadAcr.cPAccID" & _
                                  "='" & scAccID & "') AND FD_CadAcr.dbill_date='" & sDbill_date & "'" _
                                  & " AND FD_CadAcr.dFrom='" & sdFrom & "' AND FD_CadAcr.dTo='" & sdTo & _
                                  "'", dbFailOnError
                Else
                    dbsZJ.Execute "UPDATE FD_CadAcr SET FD_CadAcr.cRemark='" & edtRemark & _
                                  "' WHERE (FD_CadAcr.cGAccID='" & scAccID & "' OR FD_CadAcr.cPAccID" & _
                                  "='" & scAccID & "') AND FD_CadAcr.dbill_date='" & sDbill_date & "'" _
                                  & " AND FD_CadAcr.dFrom='" & sdFrom & "' AND FD_CadAcr.dTo='" & sdTo & _
                                  "'", dbFailOnError
                End If
                rstLXadv.Requery
                edtRemark.Locked = True
            Else
                Exit Sub
            End If
            
        Case "PriorPage"
            If bSave Then SaveYN
            MoveRecordPrev rstLXadv
            FrmRefresh
            bL = False
            
        Case "NextPage"
            If bSave Then SaveYN
            MoveRecordNext rstLXadv
            FrmRefresh
            bF = False
            
        Case "FirstPage"
            If bSave Then SaveYN
            rstLXadv.MoveFirst
            FrmRefresh
            bF = True
            bL = False
            
        Case "LastPage"
            If bSave Then SaveYN
            rstLXadv.MoveLast
            FrmRefresh
            bL = True
            bF = False
        
        Case "Help"
            SendKeys "{F1}"
            
        Case "exit"
            If bSave Then SaveYN
            Unload Me
            Exit Sub
    End Select
    If TLB_Key <> "exit" Then SetButtonStatus
    Screen.MousePointer = vbDefault

End Sub
'添置表单
Private Sub FrmRefresh()
    
    On Error Resume Next
        edtStart = FormatDate(CDate(rstLXadv![dFrom]))
        edtEnd = FormatDate(CDate(rstLXadv![dTo]))
        edtDays = (CDate(edtEnd) - CDate(edtStart)) + 1
        
        If IsNull(rstLXadv![UnitName]) Then
            txtUtName = ""
        Else
            txtUtName = rstLXadv![UnitName]
        End If
        If IsNull(rstLXadv![cAccId]) Then
            txtAccID = ""
        Else
            txtAccID = rstLXadv![cAccId]
        End If
        If IsNull(rstLXadv![FH]) Then
            txtChkCode = ""
        Else
            txtChkCode = rstLXadv![FH]
        End If
        If IsNull(rstLXadv![ZDR]) Then
            txtBillCode = ""
        Else
            txtBillCode = rstLXadv![ZDR]
        End If
        If IsNull(rstLXadv![Js]) Or rstLXadv.RecordCount = 0 Then
            edtSum = ""
        Else
            edtSum = Format(rstLXadv![Js], "#,##0.00")
        End If
        If IsNull(rstLXadv![Lxe]) Or rstLXadv.RecordCount = 0 Then
            edtInter = ""
        Else
'             edtInter = Format(CDbl(rstLXadv![Lxe]) / 2, "#,##0.00") 'cuidong Lxd/2 2002.03.18
             edtInter = Format(CDbl(rstLXadv![Lxe]), "#,##0.00")      'cuidong Lxd/2 2002.03.18
'            edtInter = FormatCur(CalLXE)
        End If
        
        OpenRst
        
        If IsNull(rstLXadv![bz]) Or rstLXadv.RecordCount = 0 Then
            edtRemark = ""
        Else
            edtRemark = rstLXadv![bz]
        End If
    On Error GoTo 0
    
End Sub

'---- 计算利息金额(为了填充edtInter) ----
Private Function CalLXE() As Currency
   Dim sqlT As String
   Dim Rst  As New UfRecordset
   
   With rstLXadv
      sqlT = "SELECT Sum(mmoney) As Lxe FROM FD_CadAcr WHERE " & _
         "(cGAccID = '" & !cAccId & "' Or cPAccID = '" & !cAccId & "') " & _
         "And dFrom = '" & !dFrom & "' " & _
         "And dTo = '" & !dTo & "'"
      Set Rst = dbsZJ.OpenRecordset(sqlT, dbOpenSnapshot)
      CalLXE = IIf(IsNull(Rst!Lxe), 0, Rst!Lxe)
   End With
   CloseRS Rst
End Function

Private Sub MoveRecordPrev(Rst As UfRecordset)
    On Error Resume Next
    With Rst:
        If Not .BOF Then
            .MovePrevious
            If .BOF Then
                .MoveFirst
                MsgBox "已是第一张单据!", vbInformation, zjGl_Name
            End If
            OpenRst
        End If
    End With
    On Error GoTo 0

End Sub

Private Sub MoveRecordNext(Rst As UfRecordset)
    On Error Resume Next
    With Rst:
        If Not .EOF Then
            .MoveNext
            If .EOF Then
                .MoveLast
                MsgBox "已是最后一张单据!", vbInformation, zjGl_Name
            End If
            OpenRst
        End If
    End With
    On Error GoTo 0
    
End Sub
'利率情况
Public Sub OpenRst()
    Dim sTXT        As String
    Dim sSqlLLdm    As String
    Dim sSqlLLtj    As String
    Dim sSqlFZ      As String
    Dim sUnitName   As String
    Dim scAccID     As String
    Dim sDbill_date As String
    Dim sdFrom      As String
    Dim sdTo        As String
    
    If rstLXadv.RecordCount = 0 Then Exit Sub
    On Error Resume Next
    sUnitName = rstLXadv![UnitName]
    scAccID = rstLXadv![cAccId]
    sDbill_date = ForDate(rstLXadv![JCR])
    sdFrom = ForDate(rstLXadv![dFrom])
    sdTo = ForDate(rstLXadv![dTo])
    sSqlLLdm = "SELECT DISTINCT FD_AccUnit.cUnitName AS UnitName, FD_AccDef.cAccID AS cAccID," & _
            " FD_CadAcr.dbill_date AS JCR,FD_CadAcr.dFrom,FD_CadAcr.dTo,FD_Intras.nzy AS NLL, " & _
            "FD_Intras.dbdate,FD_Intras.bde,FD_Intras.ncdell,FD_Intras.nde " & _
            "FROM FD_Intras INNER JOIN (FD_CadAcr INNER JOIN (FD_AccSum INNER JOIN " & _
            "(FD_AccDef INNER JOIN FD_AccUnit ON FD_AccDef.cUnitCode=FD_AccUnit.cUnitCode) " & _
            "ON FD_AccSum.cAccID=FD_AccDef.cAccID) ON FD_CadAcr.dbill_date-1=FD_AccSum.dbill_date) " & _
            "ON FD_Intras.cIntrID=FD_CadAcr.cIntrID Where (FD_CadAcr.cPAccID = FD_AccDef.cAccID " & _
            "Or FD_CadAcr.cGAccID = FD_AccDef.cAccID) AND FD_AccUnit.cUnitName = '" & sUnitName & "' AND " & _
            "FD_AccDef.cAccID='" & scAccID & "' AND FD_CadAcr.dbill_date='" & sDbill_date & "' AND FD_CadAcr.dFrom='" & _
            sdFrom & "' AND FD_CadAcr.dTo='" & sdTo & "' GROUP BY FD_AccUnit.cUnitName, FD_AccDef.cAccID, " & _
            "FD_CadAcr.dbill_date,FD_CadAcr.dFrom,FD_CadAcr.dTo,FD_Intras.dbdate,FD_Intras.nzy," & _
            "FD_Intras.bde,FD_Intras.ncdell,FD_Intras.nde"
            
    Set rstLLDM = dbsZJ.OpenRecordset(sSqlLLdm, dbOpenSnapshot)
    txtRate = ""
    With rstLLDM
        If rstLLDM Is Nothing Then Exit Sub
        While Not .EOF
            sRate1 = IIf(IsNull(rstLLDM![dbDate]), "", Year(rstLLDM![dbDate])) & "." & _
                    IIf(Len(Month(rstLLDM![dbDate])) < 2, "0" & Month(rstLLDM![dbDate]), _
                    Month(rstLLDM![dbDate])) & "." & IIf(Len(Day(rstLLDM![dbDate])) < 2, _
                    "0" & Day(rstLLDM![dbDate]), Day(rstLLDM![dbDate]))
            sRate2 = CStr(val(IIf(IsNull(rstLLDM![nLl]), 0, rstLLDM![nLl])))
            
            If rstLLDM![bDe] Then
                sRate3 = CStr(val(IIf(IsNull(rstLLDM![ncdell]), 0, rstLLDM![ncdell]))) & "%  "
                sRate4 = IIf(IsNull(rstLLDM![nDe]), "", rstLLDM![nDe])
                sTXT = sRate1 & "  年利率 " & sRate2 & "%  超定额利率 " & sRate3 & "定额 " & Format(sRate4, "#.00") & "圆"
            Else
                sTXT = sRate1 & "  年利率 " & sRate2 & "%"
            End If
            
            .MoveNext
            txtRate = txtRate & sTXT & Chr(13) + Chr(10)
        Wend
    End With
    rstLLDM.oClose
    On Error GoTo 0