银行存款.frm

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

                    Case vbNo:
                    
                    Case vbCancel:
                        xf = False
                End Select
            End If
            If xf Then
                Ckdappe '新增一张单据
                Tlbckd.Buttons("DeleteRecord").Image = "DeleteRecord"
                Tlbckd.Buttons("DeleteRecord").Caption = "删除"
                Tlbckd.Buttons("DeleteRecord").ToolTipText = "Ctrl+Y"
                Tlbckd.Buttons("CopyRecord").Image = "PasteRecord"
                Tlbckd.Buttons("CopyRecord").Caption = "粘贴"
                Tlbckd.Buttons("CopyRecord").ToolTipText = "Ctrl+V"
            End If
        Case Is = "SaveRecord"  '存盘
            If Ckdquit() Then
                CkdSave
                If isSave Then
                    Tlbckd.Buttons("DeleteRecord").Image = "DeleteRecord"
                    Tlbckd.Buttons("DeleteRecord").Caption = "删除"
                    Tlbckd.Buttons("DeleteRecord").ToolTipText = "Ctrl+Y"
                    Tlbckd.Buttons("CopyRecord").Image = "CopyRecord"
                    Tlbckd.Buttons("CopyRecord").Caption = "复制"
                    Tlbckd.Buttons("CopyRecord").ToolTipText = "Ctrl+C"
                    Combo1_GotFocus 'cuidong 2001.08.24
                End If
                'Combo1_GotFocus 'cuidong 2001.08.24
            End If
        
        Case Is = "DeleteRecord"  '删除
            If IsNew Or isSave Then
                If PromptDel = vbYes Then
                    Ckddele
                    Tlbckd.Buttons("CopyRecord").Image = "CopyRecord"
                    Tlbckd.Buttons("CopyRecord").Caption = "复制"
                    Tlbckd.Buttons("CopyRecord").ToolTipText = "Ctrl+C"
                    Getckd IIf(IsNew, 4, 2), Editbh.Text
                End If
            Else
                Getckd 3, IIf(Editbh.Text = "00000000", "0", Right(str(99999999 + Editbh.Text), 8))
                Tlbckd.Buttons("DeleteRecord").Image = "DeleteRecord"
                Tlbckd.Buttons("DeleteRecord").Caption = "删除"
                Tlbckd.Buttons("DeleteRecord").ToolTipText = "Ctrl+Y"
            End If
            Combo1_GotFocus
        Case Is = "CopyRecord"
            Setdjcopy IsNew
        Case Is = "FirstPage"    '首页
            Getckd 1, Editbh.Text
         Case Is = "PriorPage"   '上页
            Getckd 2, Editbh.Text
        Case Is = "NextPage"   '下页
            Getckd 3, Editbh.Text
        Case Is = "LastPage"   '末页
            Getckd 4, Editbh.Text
        Case Is = "Check"   '复核
            InitFrmCheck_xz True
            If CheckStatus = 0 Then
                Check "One"
            ElseIf CheckStatus = 1 Then
                Check "All"
            End If
        Case Is = "CheckCancel"   '取消
            InitFrmCheck_xz False
            If CheckStatus = 0 Then
                UnCheck "One"
            ElseIf CheckStatus = 1 Then
                UnCheck "All"
            End If
        Case Is = "PingZheng"   '凭证
            With pzInfo
               .pDjrq = Editrq.Text
               .pMoney = Editje(0)
               .pYwID = rsTckd![cSavID]
               .pZhID1 = Edityhzh.Text
               .pZhID2 = pzZhID2
               .pDigest = Editzy.Text
               .pHl = Editje(1)
               .blnFind = False
            End With
            If Err.Number <> 0 Then
                Gen_Key "NextPage"
                Exit Sub
            Else
                If ZjAccInfo.zjPrnCtrl Then Exit Sub
                ZjAccInfo.zjPrnCtrl = True
                DoVouch
                ZjAccInfo.zjPrnCtrl = False
            End If
        Case Is = "Help"
            SendKeys "{F1}"
        Case Is = "Exit"     '退出
            Unload Me
            Exit Sub
    End Select
    ckdbutt '' 根据单据属性，置工具栏按钮、参照属性
End Sub
' 新增单据存盘合法性检查
Private Function Ckdquit() As Boolean
    If isSave Then
        Ckdquit = True
        Exit Function
    End If
    
    Ckdquit = False
    
    If Editbh.Text = "" Then
        Beep
        MsgBox "业务编号不能为空，请检查！", vbCritical, zjGl_Name
        Editbh.SetFocus
        Exit Function
    Else
        Editbh.Text = Right("00000000" & Editbh.Text, 8)
    End If
    
    If Editrq.Text = "" Then
        Beep
        MsgBox "业务日期不能为空，请检查！", vbCritical, zjGl_Name
        Editrq.SetFocus
        Exit Function
    End If
    
    Editrq.Text = ForDate(Editrq.Text)
    If Not IsDate(Editrq.Text) Then
        Beep
        MsgBox "日期非法，请检查！", vbCritical, zjGl_Name
        SetTxtFocus Editrq
        isEnt(0) = False
        Exit Function
    End If
    
    If CDate(Editrq.Text) > zjLogInfo.curDate Then
        Beep
        MsgBox "业务日期不能超过系统登录时间！", vbCritical, zjGl_Name
        SetTxtFocus Editrq
        Exit Function
    End If
    
    If Ckzh_err(Editrq.Text, Edityhmc, Edityhzh, Editbh.Text, Textlldm, Textbb, True, djnwb, IIf(Option1(0).Value, 0, 1)) Then
        SetTxtFocus Edityhzh
        isEnt(2) = False
        Exit Function
    End If
    
    If Editje(0).Text = "" Then
        Beep
        MsgBox "存款金额不能为空，请检查！", vbCritical, zjGl_Name
        Editje(0).SetFocus
        Exit Function
    End If
    
    If Val(Editje(0).Text) = 0 Then
        Beep
        MsgBox "存款金额不能为0，请检查！", vbCritical, zjGl_Name
        SetTxtFocus Editje(0)
        Exit Function
    End If
    
    If Editje(1).Text = "" Then
        Beep
        MsgBox "汇率不能为空，请检查！", vbCritical, zjGl_Name
        Editje(1).SetFocus
        Exit Function
    End If
    
    If Val(Editje(1).Text) = 0 Then
        Beep
        MsgBox "汇率不能为0，请检查！", vbCritical, zjGl_Name
        SetTxtFocus Editje(1)
        Exit Function
    End If
    
'    If CDbl(Textje.Text) > CDbl("9.2E+14") Then
'        Beep
'        MsgBox "本位币金额溢出！", vbCritical, zjGl_Name
'        Editje(0).SetFocus
'        Exit Function
'    End If
    If CheckCurrencyOut(CDbl(Textje.Text)) Then
         SetTxtFocus Editje(0)
         Exit Function
    End If

    If Option1(0).Value Then
        If Editmonth.Text = "" Then
            Beep
            MsgBox "定期存款存期不能为空，请检查！", vbCritical, zjGl_Name
            Editmonth.SetFocus
            Exit Function
        End If
        If CInt(Editmonth.Text) = 0 Then
            Beep
            MsgBox "定期存款存期不能为0，请检查！", vbCritical, zjGl_Name
            SetTxtFocus Editmonth
            Exit Function
        End If
    End If
    
    If Pd_lldmer(Textlldm.Text, Editrq.Text, True) Then
        SetTxtFocus Editrq
        Exit Function
    End If
    
    Ckdquit = True
    
End Function
' 新增单据时，获取最大业务号
''''Private Function ov.getMaxID()
''''    Dim rsTemp As New UfRecordset, i As Long
''''    Set rsTemp = dbsZJ.OpenRecordset("FD_sav", dbOpenTable)
''''    With rsTemp
''''        .Index = "PrimaryKey"
''''        If djnwb = 1 Then
''''            .oSeek "<=", "02"
''''            If .EOF Then
''''                ov.getMaxID = "00000001"
''''            Else
''''                ov.getMaxID = Right(str(100000001 + Right(![cSavID], 8)), 8)
''''            End If
''''        Else
''''            If .EOF Then
''''                ov.getMaxID = "00000001"
''''            Else
''''                .MoveLast
''''                If ![cSavID] Like "03*" Then
''''                    ov.getMaxID = Right(str(100000001 + Right(![cSavID], 8)), 8)
''''                Else
''''                    ov.getMaxID = "00000001"
''''                End If
''''            End If
''''        End If
''''        If ov.getMaxID = "00000000" Then
''''            For i = 1 To 99999998
''''                ov.getMaxID = Right(str(100000000 + i), 8)
''''                .oSeek "=", IIf(djnwb = 1, "01", "03") & ov.getMaxID
''''                If .EOF Then
''''                    Exit Function
''''                End If
''''            Next
''''        End If
''''        .Close
''''    End With
''''End Function
' 新增一张单据
Private Sub Ckdappe()
    Textqk '初始化所有TEXT控件
    Editbh.Text = oV.getMaxID(IIf(djnwb = 1, "01", "03"))
    IsNew = True
End Sub

Private Sub CkdSave()
    On Error Resume Next
    Dim sav_js As Integer
    If isSave Then Exit Sub
    sav_js = 0
cf: CkdSave1
    'cuidong 2001.08.24
    '------------------------
'    If Not isSave Then
'        sav_js = sav_js + 1
'        If sav_js < 1000 Then GoTo cf
'        Beep
'        MsgBox "编码冲突 或 有其他工作站正在保存，请重新录入。", vbOKOnly + vbInformation, zjGl_Name
'    End If
    '------------------------
End Sub

' 新单据存盘
Private Sub CkdSave1()
    Dim newmaxbh As String, oldbh As String
    On Error GoTo er1
    newmaxbh = IIf(djnwb = 1, "01", "03") & Editbh.Text
    BillSaveLock IIf(djnwb = 1, "01", "03") 'cuidong 2001.08.28
    If IsNew Then
''''        Set rsTemp = dbsZJ.OpenRecordset("FD_sav", dbOpenTable)
''''        With rsTemp
''''            .Index = "PrimaryKey"
''''            .oSeek "=", newmaxbh
'''            If Not .EOF Then '= call getMaxbh
''''                If djnwb = 1 Then
''''                    .oSeek "<=", "02"
''''                Else
''''                    .MoveLast
''''                End If
''''                newmaxbh = IIf(djnwb = 1, "01", "03") & Right(str(100000001 + Right(![csavid], 8)), 8)
''''            End If
''''            .Close
'''        End With
''''        rsTckd.AddNew
'            If oV.IDExists(newmaxbh) Then newmaxbh = oV.getMaxID 'Cuidong 2000/08/14
'            If oV.IDExists(newmaxbh) Then Exit Sub               'cuidong 2001.08.22 'Cuidong 2000/08/14
            If Not oV.ValidateBillID(newmaxbh) Then Exit Sub      'cuidong 2001.08.22 'Cuidong 2000/08/14
            Editbh.Text = Right$(newmaxbh, 8)                     'cuidong 2001.08.24
    Else
        Label1(15).Caption = IIf(IsNull(rsTckd![cCheckCode]), "", rsTckd![cCheckCode])
        If Label1(15).Caption <> "" Then
            Beep
            MsgBox "对不起，这张单子已被审核过！", vbOKOnly + vbInformation, zjGl_Name
            Carddata
            isSave = True
            Exit Sub
        End If
''''        rsTckd.edit
    End If
    Savdata newmaxbh
    BillSaveUnLock IIf(djnwb = 1, "01", "03") 'cuidong 2001.08.28
    Exit Sub
er1:
    Select Case Err.Number
    Case 3167
''''    Stop
''''        rsTckd.AddNew
        IsNew = True
        Savdata newmaxbh
    Case 3022
        Savdata IIf(djnwb = 1, "01", "03") & oV.getMaxID(IIf(djnwb = 1, "01", "03"))
    End Select
    BillSaveUnLock IIf(djnwb = 1, "01", "03") 'cuidong 2001.08.28
    
End Sub
' 给窗体赋值
Private Sub Carddata()
''      rsTckd.Requery
    With rsTckd
        If Not .EOF Then
            Frtin = True
            Editrq.Text = Format(![dbill_date], "yyyy-mm-dd")
            Editbh.Text = Right(![cSavID], 8)
            Edityhzh.Text = ![cAccID]
            Edityhmc.Text = Zhbhtodwmc(Edityhzh.Text)
            Textlldm.Text = Wgetlldm(Edityhzh.Text)
            Textbb.Text = Wgetwbb(Edityhzh.Text)
            Editje(1).Text = ![nFrat]
            Editje(0).Text = Format(![mMoney], "#0.00")
            Textje.Text = Format(![mMoney_F], "#0.00")
            Editmonth.Text = IIf(![iMonth] = 0, "", ![iMonth])
            Editzy.Text = IIf(IsNull(![cDigest]), "", ![cDigest])
            Editjbr.Text = IIf(IsNull(![ctran_name]), "", ![ctran_name])
            Label1(15).Caption = IIf(IsNull(![cCheckCode]), "", ![cCheckCode])
            Label1(17).Caption = IIf(IsNull(![cBookCode]), "", ![cBookCode])
            Label1(19).Caption = ![cBillCode]
            Option1(0).Value = IIf(![isc] = 0, True, False)
            Option1(1).Value = IIf(![isc] = 0, False, True)
            Frtin = False
        Else
            Textqk
        End If
    End With
    isSave = True
    IsNew = False
End Sub
' 给表赋值
Private Sub Savdata(bh As String)
''''    With rsTckd
''''        ![dbill_date] = Editrq.Text
''''        ![csavid] = bh
''''        ![cAccID] = Edityhzh.Text
''''        ![nfrat] = CDbl(Editje(1).Text)
''''        ![mMoney] = CDbl(Editje(0).Text)
''''        ![mmoney_f] = CDbl(Textje.Text)
''''        ![iMonth] = IIf(Option1(0).Value, Editmonth.Text, 0)
''''        ![isc] = IIf(Option1(0).Value = True, 0, 1)
''''        ![ctran_name] = IIf(Editjbr.Text = "", Null, Editjbr.Text)
''''        ![cdigest] = IIf(Editzy.Text = "", Null, Editzy.Text)
''''        ![cBillCode] = zjLogInfo.cUserName
''''        .Update
''''        FindFirst rsTckd, "cSavID='" & bh & "'"
''''        Editbh.Text = Right(bh, 8)
''''    End With
   With oVd
        .RemoveAll
        .Add "dbill_date", Editrq.Text
        .Add "csavid", bh
        .Add "cAccID", Edityhzh.Text
        .Add "nfrat", CDbl(Editje(1).Text)
        .Add "mMoney", CDbl(Editje(0).Text)
        .Add "mmoney_f", CDbl(Textje.Text)
        .Add "iMonth", IIf(Option1(0).Value, Editmonth.Text, 0)
        .Add "isc", IIf(Option1(0).Value = True, 0, 1)
        .Add "ctran_name", IIf(Editjbr.Text = "", Null, Editjbr.Text)
        .Add "cdigest", IIf(Editzy.Text = "", Null, Editzy.Text)
        .Add "cBillCode", zjLogInfo.cUserName
    End With
    If IsNew Then
       'oV.Add oVd                               'cuidong 2001.08.24