-i+

VB开发的ERP系统

    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With RecTemp
        If Not .EOF Then
            '[>>显示单据
            TextChangeLock = True     '文本框加锁
                 
                 Dim Int_Modulus As Integer                '金额系数(针对退款单)
                 Select Case .Fields("BillItemCode")
                    Case "30"  '到款
                      Int_Modulus = 1
                      Combo_Skdlx.ListIndex = 0
                    Case "31"  '预收款
                      Int_Modulus = 1
                      Combo_Skdlx.ListIndex = 1
                    Case "32"  '退款单
                      Combo_Skdlx.ListIndex = 2
                      Int_Modulus = -1
                 End Select
                             
                 LrText(0).Text = Trim(.Fields("BillCode"))                               '单据编号
                 
                 LrText(1).Text = Format(.Fields("BillDate"), "yyyy-mm-dd")               '单据日期
                 
                 LrText(2).Tag = Trim(.Fields("PSCode"))                                  '客户编码
                 LrText(2).Text = Trim(.Fields("CusName") & "")                           '客户名称
                 
                                
                 LrText(3).Tag = Trim(.Fields("SScode") & "")                             '结算方式编码
                 LrText(3).Text = Trim(.Fields("SSName") & "")                            '结算方式名称
                 
                 
                 LrText(4).Text = Trim(.Fields("AccCode") & "")                          '结算科目
                 
                 LrText(5).Tag = Trim(.Fields("ForeignCurrCode") & "")                    '原币编码
                 LrText(5).Text = Trim(.Fields("ForeignCurrName") & "")                   '原币名称
                 
                 LrText(6).Text = .Fields("AccRate")                                      '记帐汇率
                 LrText(7).Text = .Fields("Ybssje") * Int_Modulus                         '原币金额
                 
                 LrText(8).Text = Trim(.Fields("BankBillNo") & "")                        '银行票号
                 LrText(9).Text = Trim(.Fields("BankCode") & "")                          '银行帐号
                 
                 LrText(10).Tag = Trim(.Fields("DeptCode") & "")                          '部门编码
                 LrText(10).Text = Trim(.Fields("DeptName") & "")                         '部门名称
                 
                 LrText(11).Tag = Trim(.Fields("PersonCode") & "")                        '经办人编码
                 LrText(11).Text = Trim(.Fields("PersonName") & "")                       '经办人名称
                 
                 LrText(12).Text = Trim(.Fields("Digest") & "")                           '摘要
                 
                 LrText(13).Text = Trim(.Fields("Maker") & "")                            '制单人
                 LrText(14).Text = Trim(.Fields("Checker") & "")                          '审核人

            TextChangeLock = False    '文本框解锁
            '<<]
        End If
    End With
    
    '设置审核弃审按钮状态
    '通过应收明细帐进行明细查询时审核和核销按钮进行灰化处理
    If Xtcdcs <> "3" Then
        Call Sub_CheckStatus
    End If
    
End Sub

Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
    
    '屏蔽文本框,下拉组合框有效性判断
    Valilock = True
    
    '屏蔽网格失去焦点产生的有效性判断
    changelock = True
    
    Select Case Button.Key
    Case "yl"                                            '预 览
        BillTextPrint Lab_Title, LrText, TextGroupCode, XtReportCode, False
    Case "dy"                                            '打 印
        Dim yhAnswer As Integer      '打印提示

        '用户确认是否打印单据
        Tsxx = "请确认是否打印当前单据?"
        yhAnswer = Xtxxts(Tsxx, 2, 2)
        If yhAnswer = 2 Then
            Exit Sub
        End If
        BillTextPrint Lab_Title, LrText, TextGroupCode, XtReportCode, True
    Case "xz"                                            '新 增
        Call Sub_AddBill
    Case "xg"                                            '修 改
        Call Sub_EditBill
    Case "sc"                                            '删 除
        Call Sub_DeleteBill
    Case "bc"                                            '保 存
        Call Sub_SaveBill
    Case "fq"                                            '放 弃
        Call Sub_AbandonBill
    Case "shsh"                                          '审 核
        Call Sub_CheckBill
    Case "hx"                                            '核 销
        Call Sub_CancelBill
    Case "first"                                         '首 张
        Call Sub_First
    Case "prev"                                          '上 张
        Call Sub_Prev
    Case "next"                                          '下 张
        Call Sub_next
    Case "last"                                          '末 张
        Call Sub_Last
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Unload Me
    End Select
    
    '解 锁
    Valilock = False
    changelock = False
    TextChangeLock = False
    
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)     '支持热键操作
    
    Select Case KeyCode
    Case vbKeyF5          '增加单据
        If Tlb_Action.Buttons("xz").Enabled And Tlb_Action.Buttons("xz").Visible Then
            Call Sub_AddBill
        End If
    Case vbKeyF3          '修改单据
        If Tlb_Action.Buttons("xg").Enabled And Tlb_Action.Buttons("xg").Visible Then
            Call Sub_EditBill
        End If
    Case vbKeyF6          '保存单据
        If Tlb_Action.Buttons("bc").Enabled And Tlb_Action.Buttons("bc").Visible Then
            Call Sub_SaveBill
        End If
    End Select
    
End Sub

Private Sub Sub_OperStatus(Str_Status As String)                 '工具条依据不同状态所进行的变化
    
    With Tlb_Action
        Select Case Str_Status
        Case "10"   '浏览((列表)调入单据处理时的进入状态、(列表)新增状态时放弃录入)
            '工具条
            .Buttons("dy").Enabled = True       '打印
            .Buttons("yl").Enabled = True       '预览
            .Buttons("xz").Enabled = True       '新增
            .Buttons("xg").Enabled = True       '修改
            .Buttons("sc").Enabled = True       '删除
            .Buttons("bc").Enabled = False      '保存
            .Buttons("fq").Enabled = False      '放弃
            .Buttons("first").Enabled = True    '首张
            .Buttons("prev").Enabled = True     '上张
            .Buttons("next").Enabled = True     '下张
            .Buttons("last").Enabled = True     '末张
            .Buttons("bz").Enabled = True       '帮助
            .Buttons("fh").Enabled = True       '退出
            
            '设置审核弃审按钮状态
            Call Sub_CheckStatus
            
            '设置文本框录入状态
            Call Sub_LrtextStatus(False)
            
            '置单据列表框为False
            Combo_Skdlx.Enabled = False
            
        Case "20"   '新增单据(（录入）新增一张单据 、（列表）新增一张单据)
            '工具条
            .Buttons("dy").Enabled = False      '打印
            .Buttons("yl").Enabled = False      '预览
            .Buttons("xz").Enabled = False      '新增
            .Buttons("xg").Enabled = False      '修改
            .Buttons("sc").Enabled = False      '删除
            .Buttons("bc").Enabled = True       '保存
            .Buttons("fq").Enabled = True       '放弃
            .Buttons("shsh").Enabled = False    '审核
            .Buttons("hx").Enabled = False      '弃审
            .Buttons("first").Enabled = False   '首张
            .Buttons("prev").Enabled = False    '上张
            .Buttons("next").Enabled = False    '下张
            .Buttons("last").Enabled = False    '末张
            .Buttons("bz").Enabled = True       '帮助
            .Buttons("fh").Enabled = True       '退出
            
            '设置文本框录入状态
            Call Sub_LrtextStatus(True)
            
            '置单据列表框为True
            Combo_Skdlx.Enabled = True
            
        Case "30"   '修改(（录入）调入修改功能、（列表）调入修改功能)
            '工具条
            .Buttons("dy").Enabled = False      '打印
            .Buttons("yl").Enabled = False      '预览
            .Buttons("xz").Enabled = False      '新增
            .Buttons("xg").Enabled = False      '修改
            .Buttons("sc").Enabled = False      '删除
            .Buttons("bc").Enabled = True       '保存
            .Buttons("fq").Enabled = True       '放弃
            .Buttons("shsh").Enabled = False    '审核
            .Buttons("hx").Enabled = False      '弃审
            .Buttons("first").Enabled = False   '首张
            .Buttons("prev").Enabled = False    '上张
            .Buttons("next").Enabled = False    '下张
            .Buttons("last").Enabled = False    '末张
            .Buttons("bz").Enabled = True       '帮助
            .Buttons("fh").Enabled = True       '退出
            
            '设置文本框录入状态
            Call Sub_LrtextStatus(True)
            
            '置单据列表框为True
            Combo_Skdlx.Enabled = True

        End Select
    End With
    
End Sub

Private Sub Sub_LrtextStatus(TextEnabled As Boolean)                            '设置录入文本框状态
    
    '录入文本框状态设置
    If TextEnabled Then
        For jsqte = Max_Text_Index To 0 Step -1
            '判断文本框是否可编辑
            If Textboolean(jsqte, 5) Then
                LrText(jsqte).Enabled = True
            Else
                LrText(jsqte).Enabled = False
            End If
        Next jsqte
    Else
        For jsqte = Max_Text_Index To 0 Step -1
            LrText(jsqte).Enabled = False
        Next jsqte
    End If
    
End Sub

Private Sub Sub_CheckStatus()                                       '设置审核弃审按钮状态(亦可设置其他动作按钮状态)
    
    '根据当前单据状态来确定审核弃审按钮状态
    If Trim(LrText(13).Text) <> "" And Trim(LrText(14).Text) = "" Then
        Tlb_Action.Buttons("shsh").Enabled = True      '审核
    Else
        Tlb_Action.Buttons("shsh").Enabled = False   '审核
    End If
    If Trim(LrText(13).Text) <> "" And Trim(LrText(14).Text) <> "" Then
        Tlb_Action.Buttons("hx").Enabled = True      '核销
    Else
        Tlb_Action.Buttons("hx").Enabled = False     '核销
    End If
    
End Sub

Private Sub Sub_AddBill()                                                '新增一张单据
    
    Dim RecTemp As New ADODB.Recordset            '临时使用动态集
    Dim jsqte As Long                             '临时计数器
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Ar_GatheringBill_Edit", Xtczybm, 1, True) Then
        Exit Sub
    End If
    
    '设置操作状态为新增(Fixed)
    Lab_OperStatus.Caption = "2"
    
    '设置工具条状态(Fixed)
    Call Sub_OperStatus("20")
    
    '清空VouchID(Fixed)
    Lab_BillId.Caption = ""
    
    '录入文本框清除内容
    For jsqte = Max_Text_Index To 0 Step -1
        LrText(jsqte).Tag = ""
        LrText(jsqte).Text = ""
    Next jsqte
    
    '[>>显示制单人,清空审核人,此处还可以设置录入默认值如自动生成单据号、默认单据录入日期注意加锁
    LrText(13).Text = Xtczy
    LrText(14).Text = ""
    
    '设置订单日期默认为系统业务日期,默认币别为本位币
    TextChangeLock = True
        LrText(1).Text = Xtrq
        LrText(5).Text = XtSCurrName
        LrText(5).Tag = XtSCurrCode
        LrText(6).Text = 1
    TextChangeLock = False
    
    '读取最新的单据编码
    LrText(0).Text = CreatBillCode(BillCode, False)
    
    '<<]
    
    '让第一个录入项得到焦点(Fixed)
    On Error Resume Next
    LrText(1).SetFocus
    
End Sub

Private Sub Sub_EditBill()                                                '修改一张单据
    
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Ar_GatheringBill_Edit", Xtczybm, 1, True) Then
        Exit Sub
    End If
    
    '非有效单据不予进行修改动作
    If Val(Lab_BillId.Caption) = 0 Then
        Exit Sub
    End If
    
    '判断当前单据是否允许修改
    If Not Fun_AllowEdit Then
        Exit Sub
    End If