-+

VB财务软件系统下载源代码提供自由下载使用学习

        .Add "cPAccID", Edityhzh(1).Text
        .Add "nfrat", CDbl(Editje(1).Text)
        .Add "mMoney", CDbl(Editje(0).Text)
        .Add "mmoney_f", CDbl(Textje.Text)
        .Add "cdigest", IIf(Editzy(0).Text = "", Null, Editzy(0).Text)
        .Add "crun_name", IIf(Editzy(1).Text = "", Null, Editzy(1).Text)
        .Add "cpay_name", IIf(Editzy(2).Text = "", Null, Editzy(2).Text)
        .Add "cset_name", IIf(Editzy(3).Text = "", Null, Editzy(3).Text)
        .Add "cBillCode", zjLogInfo.cUserName
        .Add "icen_id", "1"
'''        .Update
'''        .Find "cSetID='15" & Editbh & "'"
    End With
    If IsNew Then
       If Not oV.Add(oVd) Then Err = 0: Exit Sub
    Else
       If Not oV.Edit(oVd, bh) Then Err = 0: Exit Sub
    End If
    isSave = True
    IsNew = False
    Label1(21).Caption = zjLogInfo.cUserName
End Sub
' 根据单据属性，置工具栏按钮、参照属性
Private Sub ckdbutt()
    Dim czk As Boolean
    If Label1(17).Caption = "" Then
        If rsTckd.EOF And (Not IsNew) Then
            czk = False
            isFh = False
        Else
            czk = True
            isFh = False
            If isSave Then
                If oV.hasMadePZ("15" & Editbh.Text) Then
                    isFh = True
                End If
            End If
        End If
        but_ctrl Not isFh, czk
    Else
        isFh = True
        czk = True
        but_ctrl False
    End If
    Editbh.Locked = Not IsNew
    Editrq.Locked = isFh
    Edityhmc(0).Locked = isFh
    Edityhzh(0).Locked = isFh
    Edityhmc(1).Locked = isFh
    Edityhzh(1).Locked = isFh
    Editje(0).Locked = isFh
    Editje(1).Locked = isFh Or Textbb.Text = ZjAccInfo.zjStandExch
   
    Editzy(0).Locked = isFh
    Editzy(1).Locked = isFh
    Editzy(2).Locked = isFh
    Editzy(3).Locked = isFh
'''    Pagezt Tlbckd, rsTckd, IsNew Or Not isSave
    Frtin = True
    If Not IsNew And isSave Then
        On Error Resume Next
        Editbh.Visible = False
        If Editbh.Text = "" Then
            Combo1.clear
        Else
            Combo1.Text = Editbh.Text
            If Err.Number = 383 Then
                Combo1.AddItem Editbh.Text
                Combo1.Text = Editbh.Text
            End If
        End If
        Combo1.Visible = True
    Else
        Editbh.Visible = True
        If isSave And IsNew Then
            Editbh.SetFocus
        End If
        Combo1.Visible = False
    End If
    Frtin = False
        oV.setPageState Tlbckd, Combo1, IsNew Or Not isSave

End Sub

Private Sub but_ctrl(Fhbz As Boolean, Optional czk As Boolean)
    If Fhbz Then
        Dim tbn As Boolean
        Emptyckd czk, czk
        tbn = (Not rsTckd.EOF) And isSave And (Not IsNew)
        Tlbckd.Buttons("Preview").Enabled = tbn
        Tlbckd.Buttons("Print").Enabled = tbn
        Tlbckd.Buttons("Dataout").Enabled = tbn
        Tlbckd.Buttons("SaveRecord").Enabled = Not isSave
        Tlbckd.Buttons("DeleteRecord").Enabled = (Not rsTckd.EOF) Or IsNew
        Tlbckd.Buttons("CopyRecord").Enabled = tbn Or IsNew And Djcopy(0) <> ""
        If Checkqx Then
            Tlbckd.Buttons("Check").Enabled = tbn
            Tlbckd.Buttons("CheckCancel").Enabled = tbn
        End If
        Tlbckd.Buttons("PingZheng").Enabled = tbn
    Else
        Emptyckd True, False
        Tlbckd.Buttons("Preview").Enabled = True
        Tlbckd.Buttons("Print").Enabled = True
        Tlbckd.Buttons("Dataout").Enabled = True
        Tlbckd.Buttons("SaveRecord").Enabled = False
        Tlbckd.Buttons("DeleteRecord").Enabled = False
        Tlbckd.Buttons("CopyRecord").Enabled = True
        If Checkqx Then
            Tlbckd.Buttons("Check").Enabled = True
            Tlbckd.Buttons("CheckCancel").Enabled = True
        End If
        Tlbckd.Buttons("PingZheng").Enabled = True
    End If
End Sub
' 置所有可获得焦点控件属性
Private Sub Emptyckd(fsk As Boolean, cmdfs As Boolean)
    Editbh.Enabled = fsk
    Editrq.Enabled = fsk
    Edityhmc(0).Enabled = fsk
    Edityhzh(0).Enabled = fsk
    Edityhmc(1).Enabled = fsk
    Edityhzh(1).Enabled = fsk
    Editje(0).Enabled = fsk
    Editje(1).Enabled = fsk
    
    Editzy(0).Enabled = fsk
    Editzy(1).Enabled = fsk
    Editzy(2).Enabled = fsk
    Editzy(3).Enabled = fsk
      
    Refyhmc(0).Enabled = cmdfs
    Refyhmc(1).Enabled = cmdfs
    refyhzh(0).Enabled = cmdfs
    refyhzh(1).Enabled = cmdfs
    cmdrq.Enabled = cmdfs
End Sub
'初始化Text
Private Sub Textqk()
    Frtin = True
    Editrq.Text = Format(zjLogInfo.curDate, "yyyy-mm-dd")           '日期赋初始值
    Editbh.Text = ""
    Edityhmc(0).Text = ""
    Edityhzh(0).Text = ""
    Edityhmc(1).Text = ""
    Edityhzh(1).Text = ""
    Textbb.Text = ""
    Editje(0).Text = ""
    Editje(1).Text = ""
    Textje.Text = ""
    Editzy(0).Text = ""
    Editzy(1).Text = ""
    Editzy(2).Text = ""
    Editzy(3).Text = ""
    Label1(17).Caption = ""
    Label1(19).Caption = ""
    Label1(21).Caption = ""
    isSave = True
    IsNew = False
    Frtin = False
End Sub
'删除单据
Private Sub Ckddele()
    On Error Resume Next
    If Not IsNew And IsNull(rsTckd!cCheckCode) Then
        ''''rsTckd.Delete
        oV.Delete rsTckd.Fields!cSetid
    End If
    isSave = True
    IsNew = False
End Sub
'翻页
Private Sub Getckd(zt As Integer, bhk As String)
    On Error GoTo reqer3
    If rsTckd Is Nothing Then
reqer3: Set rsTckd = oV.getUnBookRst
      Else
        rsTckd.Requery
    End If
    With rsTckd
        If .EOF Then
            Textqk
            Exit Sub
        End If
        .MoveLast
    End With
    Select Case zt
        Case Is = 1
            rsTckd.MoveFirst
        Case Is = 2
            With rsTckd
                FindFirst rsTckd, "csetid >= '15" & bhk & "'"
                If .EOF Then
                    .MoveLast
                Else
                    .MovePrevious
                    If .BOF Then
                        .MoveNext
                    End If
                End If
            End With
        Case Is = 3
            With rsTckd
                FindFirst rsTckd, "csetid > '15" & bhk & "'"
                If .EOF Then
                    .MoveLast
                End If
            End With
        Case Is = 4
            rsTckd.MoveLast
    End Select
    Carddata
End Sub
' 单据复核
Private Sub Check(mCount As String)
    Dim id As Integer, CurBookMark As String
    On Error GoTo er1
    Select Case mCount
        Case "One":
            Label1(17).Caption = IIf(IsNull(rsTckd![cCheckCode]), "", rsTckd![cCheckCode])
            If Label1(17).Caption <> "" Then
                Beep
                MsgBox "对不起，这张单子已被审核过！", vbOKOnly + vbInformation, zjGl_Name
            Else
                If zjLogInfo.cUserName = Label1(21) Then
                    Beep
                    MsgBox "审核与制单不能为同一人！", vbInformation, zjGl_Name
                Else
                        oV.editChecker zjLogInfo.cUserName, rsTckd.Fields!cSetid

                    Label1(17).Caption = zjLogInfo.cUserName
                End If
            End If
            
        Case "All":
            With rsTckd
                .MoveFirst
                While Not .EOF
                    If IsNull(![cCheckCode]) Then
                        If ![cBillCode] <> zjLogInfo.cUserName Then
                              oV.editChecker zjLogInfo.cUserName, rsTckd.Fields!cSetid

                        End If
                    End If
                    .MoveNext
                Wend
            End With
    End Select
er1:
    Getckd 3, Editbh.Text
    ckdbutt
End Sub
' 已复核单据取消复核
Private Sub UnCheck(mCount As String)
    Dim CurBookMark As String, id As Integer
    On Error GoTo er1
    Select Case mCount
        Case "One":
            If Label1(17).Caption <> "" Then
                If zjLogInfo.cUserName = Label1(17).Caption Then
                  oV.editChecker Null, rsTckd.Fields!cSetid
                Else
                    Beep
                    MsgBox "已复核单据，只能由复核人本人取消复核！", vbInformation, zjGl_Name
                End If
            End If
        Case "All":
            With rsTckd
                .MoveFirst
                While Not .EOF
                    If Not IsNull(![cCheckCode]) Then
                        If zjLogInfo.cUserName = ![cCheckCode] Then
                              oV.editChecker Null, rsTckd.Fields!cSetid
                        End If
                    End If
                    .MoveNext
                Wend
            End With
    End Select
er1:
''''    Getckd 3, Right(str(100000001 + Editbh.Text), 8)
    Getckd 3, Editbh.Text
    ckdbutt
End Sub
'窗体中、英文设置
Private Sub InjsForm()
    Checkqx = Informtlb(Tlbckd, ImageList1, True, 14)
    Me.Icon = LoadResPicture(109, vbResIcon)
    Me.Caption = "内部结算单"
    cmdrq.Picture = LoadResPicture(1108, vbResBitmap)
    Label1(0).Caption = "内部结算单"
    Label1(1).Caption = "业务编号"
    Label1(2).Caption = "日期"
    Label1(3).Caption = "收款单位"
    Label1(4).Caption = "收款账号"
    Label1(5).Caption = "付款单位"
    Label1(6).Caption = "付款账号"
    Label1(7).Caption = "结算金额"
    Label1(8).Caption = "币别"
    Label1(9).Caption = "汇率"
    Label1(10).Caption = "本位币金额"
    Label1(11).Caption = "摘要"
    Label1(12).Caption = "收款经办"
    Label1(13).Caption = "付款经办"
    Label1(14).Caption = "中心经办"
    Label1(16).Caption = "审核:"
    Label1(18).Caption = "记账:"
    Label1(20).Caption = "制单:"
End Sub

Private Sub Tbr_Change()
    If Frtin Then
        Exit Sub
    End If
    If isSave Then
        Tlbckd.Buttons("Preview").Enabled = False
        Tlbckd.Buttons("Print").Enabled = False
        Tlbckd.Buttons("Dataout").Enabled = False
        Tlbckd.Buttons("SaveRecord").Enabled = True
        Tlbckd.Buttons("CopyRecord").Enabled = False
        Tlbckd.Buttons("FirstPage").Enabled = False
        Tlbckd.Buttons("PriorPage").Enabled = False
        Tlbckd.Buttons("NextPage").Enabled = False
        Tlbckd.Buttons("LastPage").Enabled = False
        If Checkqx Then
            Tlbckd.Buttons("Check").Enabled = False
            Tlbckd.Buttons("CheckCancel").Enabled = False
        End If
        Tlbckd.Buttons("PingZheng").Enabled = False
        If Not IsNew Then
            Tlbckd.Buttons("DeleteRecord").Image = "RestoreRecord"
            Tlbckd.Buttons("DeleteRecord").Caption = "恢复"
            Tlbckd.Buttons("DeleteRecord").ToolTipText = "Ctrl+R"
        End If
        Combo1.Visible = False
        Editbh.Visible = True
        isSave = False
    End If
    
End Sub

Private Sub Setdjcopy(fsk As Boolean)
    If fsk Then
        Frtin = True
        Edityhzh(0).Text = Djcopy(0)
        Edityhzh(1).Text = Djcopy(1)
        Edityhmc(0).Text = Djcopy(2)
        Edityhmc(1).Text = Djcopy(3)
        Editje(0).Text = Djcopy(4)
        Editje(1).Text = Djcopy(5)
        Textje.Text = Djcopy(6)
        Textbb.Text = Djcopy(7)
        Editzy(0).Text = Djcopy(8)
        Editzy(1).Text = Djcopy(9)
        Editzy(2).Text = Djcopy(10)
        Editzy(3).Text = Djcopy(11)
        Frtin = False
        isSave = False
    Else
        Djcopy(0) = Edityhzh(0).Text
        Djcopy(1) = Edityhzh(1).Text
        Djcopy(2) = Edityhmc(0).Text
        Djcopy(3) = Edityhmc(1).Text
        Djcopy(4) = Editje(0).Text
        Djcopy(5) = Editje(1).Text
        Djcopy(6) = Textje.Text
        Djcopy(7) = Textbb.Text
        Djcopy(8) = Editzy(0).Text
        Djcopy(9) = Editzy(1).Text
        Djcopy(10) = Editzy(2).Text
        Djcopy(11) = Editzy(3).Text
    End If
End Sub