VB开发的ERP系统

                End If
            End If
        End If
    Next Jsqte
    
    If ImgCmbClass.Text = "" Then
        Tsxx = tsLabel(2).Caption & "不能为空!"
        Call Xtxxts(Tsxx, 0, 1)
        ImgCmbClass.SetFocus
        Bclrsj = False
        Exit Function
    Else
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select * from Cwzz_VouchClass Where VouchClassCode='" & Trim(GetComboKey(ImgCmbClass, 0)) & "'")
    End If
    
    '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
    For Jsqte = 0 To Max_Text_Index
        If Textint(Jsqte, 9) = 0 Or Textint(Jsqte, 9) = 2 Then   '需要进行有效性判断的字段存盘之前再进行判断。
            If Not TextYxxpd(Jsqte) Then
                Exit Function
            End If
        End If
    Next Jsqte
    
    On Error GoTo Swcwcl
    If Lrzt = 1 Then  '增 加一个新编码时
        With Rec_AutoTranMain
            If .State = 1 Then .Close
            .Open "SELECT * FROM Cwzz_AutoTranMain WHERE TranCode= '" + Trim(LrText(0).Text) + "' and TranClass='" & TranClassCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If Not .EOF Then
                Tsxx = "转帐编码重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(0).SetFocus
                Bclrsj = False
                Exit Function
            End If
            If .State = 1 Then .Close
            .Open "SELECT * FROM Cwzz_AutoTranMain WHERE TranName= '" + Trim(LrText(1).Text) + "' and TranClass='" & TranClassCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If Not .EOF Then
                Tsxx = "转帐名称重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(1).SetFocus
                Bclrsj = False
                Exit Function
            End If
            .AddNew
            .Fields("TranClass") = TranClassCode
            .Fields("TranCode") = Trim(LrText(0).Text)
            .Fields("TranName") = Trim(LrText(1).Text)
            .Fields("VouchClassCode") = Trim(GetComboKey(ImgCmbClass, 0))
            .Update
        End With
        SqlStr = "SELECT cwzz_VouchClass.VouchClassCode,cwzz_VouchClass.VouchClassName, Cwzz_AutoTranMain.TranName, " & _
        "Cwzz_AutoTranMain.TranCode, Cwzz_AutoTranMain.VouchClassCode," & _
        "Cwzz_AutoTranMain.EndTranDate , Cwzz_AutoTranMain.Bill FROM Cwzz_AutoTranMain LEFT OUTER JOIN " & _
        "Cwzz_VouchClass ON " & _
        "Cwzz_AutoTranMain.VouchClassCode = Cwzz_VouchClass.VouchClassCode WHERE trancode = '" & Trim(LrText(0)) & "' and TranClass='" & TranClassCode & "'" & _
        "ORDER BY Cwzz_AutoTranMain.TranCode"
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
        With CzxsGrid
            .AddItem ""
            .RowHeight(.Rows - 1) = Sjhgd
            .Select .Rows - 1, Qslz
            Call Jltcwg(RecTemp, .Rows - 1)
        End With
        
        Tsxx = "保存成功!"
        Call Xtxxts(Tsxx, 0, 4)
        Call Cshlrxx(1)
        LrText(0).SetFocus
    Else  '修改转帐名称或转帐类型时 修改编辑状态
        With Rec_AutoTranMain
            If .State = 1 Then .Close
            .Open "SELECT * FROM Cwzz_AutoTranMain WHERE TranName= '" + Trim(LrText(1).Text) + "' and TranCode<>'" & Trim(LrText(0).Text) & "' and TranClass='" & TranClassCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If Not .EOF Then
                Tsxx = "转帐名称重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(1).SetFocus
                Bclrsj = False
                Exit Function
            End If
            If .State = 1 Then .Close
            .Open "SELECT * FROM Cwzz_AutoTranMain WHERE TranCode= '" + LrText(0).Text + "' and TranClass='" & TranClassCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If Not .EOF Then
                .Fields("TranName") = Trim(LrText(1).Text)
                .Fields("VouchClassCode") = Trim(GetComboKey(ImgCmbClass, 0))
            End If
            .Update
            .Close
        End With
        SqlStr = "SELECT Cwzz_VouchClass.VouchClassName, Cwzz_AutoTranMain.TranName," & _
        "Cwzz_AutoTranMain.TranCode,Cwzz_AutoTranMain.VouchClassCode, Cwzz_AutoTranMain.EndTranDate," & _
        "Cwzz_AutoTranMain.Bill    FROM Cwzz_AutoTranMain LEFT OUTER JOIN " & _
        "Cwzz_VouchClass ON  Cwzz_AutoTranMain.VouchClassCode = Cwzz_VouchClass.VouchClassCode  WHERE trancode = '" & Trim(LrText(0)) & "' and TranClass='" & TranClassCode & "'"
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
        If Not RecTemp.EOF Then
            Call Jltcwg(RecTemp, CzxsGrid.Row)
        End If
    End If
    Bclrsj = True
    Exit Function
    
Swcwcl:
    Tsxx = "存盘过程中出现错误,请退出后重新进入!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function
    
End Function

Private Sub Cshlrxx(lrztxx As Integer)              '初始化录入字段信息
    
    TextChangeLock = True       '关闭Chang事件
    If lrztxx = 1 Then              '新增状态
        For Jsqte = 0 To Max_Text_Index
            If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then  '文本框索引值
                TextChangeLock = True
                LrText(Jsqte).Text = ""
                LrText(Jsqte).Tag = ""
                TextChangeLock = False
            End If
            TextValiJudgeLock(Jsqte) = True
        Next Jsqte
        ImgCmbClass.Text = ""
    Else                            '其他状态，修改、非编辑
        With CzxsGrid
            LrText(0).Text = Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls)))
            LrText(1).Text = Trim(.TextMatrix(.Row, Sydz("002", GridStr(), Szzls)))
            ImgCmbClass.Text = Trim(.TextMatrix(.Row, Sydz("003", GridStr(), Szzls)))
        End With
    End If
    TextChangeLock = False
    
End Sub

Private Sub Scdqjl()                 '删 除 当 前 记 录
    
    Dim yhAnswer As Integer
    If CzxsGrid.Row < CzxsGrid.FixedRows Then
        Exit Sub
    End If
    Tsxx = "请确认是否删除当前记录?"
    yhAnswer = Xtxxts(Tsxx, 2, 2)
    If yhAnswer = 2 Then
        Exit Sub
    End If
    On Error GoTo Cwcl
    
    Cw_DataEnvi.DataConnect.BeginTrans
    Cw_DataEnvi.DataConnect.Execute "delete Cwzz_AutoTranItem where TranCode= '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "' and TranClass='" & TranClassCode & "'"
    Cw_DataEnvi.DataConnect.Execute "delete Cwzz_AutoTranMain where TranCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "' and TranClass='" & TranClassCode & "'"
    Cw_DataEnvi.DataConnect.CommitTrans
    
    CzxsGrid.RemoveItem CzxsGrid.Row
    Exit Sub
    
Cwcl:
    If Err.Number = -2147217900 Then
        Tsxx = "该编码已经被使用,不能删除!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    Else
        Tsxx = "出现未知情况,该编码不能被删除!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
End Sub

'******************以下为基本处理程序(固定不变)************************'
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
    If Shift = 2 Then
        Select Case UCase(Chr(KeyCode))
        Case "P"                   'Ctrl+P 打印
            Call bbyl(False)
        Case "I"                   'Ctrl+I 增加
            Call Toolbjzt
            Lrzt = 1
            Call Cshlrxx(Lrzt)
            LrText(0).SetFocus
            LrText(0).Locked = False
        Case "D"                   'Ctrl+D 删除
            Call Scdqjl
        End Select
    End If
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
    Case "ymsz"                                          '页面设置
        Dyymctbl.Show 1
    Case "yl"                                            '预 览
        Call bbyl(True)
    Case "dy"                                            '打 印
        Call bbyl(False)
    Case "zj"                                            '增 加
        Call Toolbjzt
        Lrzt = 1
        Call Cshlrxx(Lrzt)
        LrText(0).SetFocus
        LrText(0).Locked = False
    Case "xg"                                            '修 改
        Call Xgdqjl
    Case "sc"                                            '删 除
        Call Scdqjl
    Case "fq"                                            '取 消
        Call Toolfbjzt
    Case "sx"                                            '刷 新
        Call Cxnrtcwg
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Unload Me
        '[自定义
    Case "run"
        '[>>计算会计期间
        Int_Year = Val(Mid(Combo_KJQJ.Text, 1, 4))
        Int_Period = Val(Mid(Combo_KJQJ.Text, 6, 2))
        '<<]
        Select Case TranClassCode
        Case "01"                           '执行自定义转帐凭证
            Call Run1
        Case "04"                           '执行期间损益
            Call Run4
        Case "05"                           '模式转帐凭证
            Call Run5
        Case "03"                           '汇兑损益凭证
            Call Run3
        End Select
    Case "define"                                '定义转帐凭证
        Call Define
        '自定义]
    End Select
End Sub

Private Sub CzxsGrid_DblClick()                            '修改当前编码记录
    With CzxsGrid
        If .Row < .FixedRows Then
            Exit Sub
        End If
        If GridStr(.Col, 1) <> "006" Then
            Call Xgdqjl
        Else
            If .TextMatrix(.Row, Sydz("006", GridStr(), Szzls)) = "√" Then
                .TextMatrix(.Row, Sydz("006", GridStr(), Szzls)) = ""
            Else
                .TextMatrix(.Row, Sydz("006", GridStr(), Szzls)) = "√"
            End If
        End If
    End With
End Sub

Private Sub Xgdqjl()                                       '修改当前编码记录
    If CzxsGrid.Row < CzxsGrid.FixedRows Then
        Exit Sub
    End If
    Call Toolbjzt
    Lrzt = 2
    Call Cshlrxx(Lrzt)
    LrText(1).SetFocus
    LrText(0).Locked = True
End Sub

Private Sub Toolbjzt()                                     'Toolbar状态(编辑状态)
    StTab.TabEnabled(1) = True
    StTab.Tab = 1
    Frame1.Enabled = True
    StTab.TabEnabled(0) = False
    CzxsGrid.Enabled = False
    With SzToolbar
        .Buttons("ymsz").Enabled = False
        .Buttons("dy").Enabled = False
        .Buttons("yl").Enabled = False
        .Buttons("zj").Enabled = False
        .Buttons("xg").Enabled = False
        .Buttons("sc").Enabled = False
        '[自定义
        .Buttons("define").Enabled = False
        .Buttons("run").Enabled = False
        '自定义]
    End With
    '[自定义
    With GsToolbar
        .Buttons("bcgs").Enabled = False
        .Buttons("hfmrgs").Enabled = False
        .Buttons("szxsxm").Enabled = False
    End With
    '自定义]
End Sub

Private Sub Toolfbjzt()                                    'Toolbar状态(非编辑状态)
    StTab.TabEnabled(0) = True
    StTab.Tab = 0
    CzxsGrid.Enabled = True
    Frame1.Enabled = False
    StTab.TabEnabled(1) = False
    Lrzt = 0
    With SzToolbar
        .Buttons("ymsz").Enabled = True
        .Buttons("dy").Enabled = True
        .Buttons("yl").Enabled = True
        .Buttons("zj").Enabled = True
        .Buttons("xg").Enabled = True
        .Buttons("sc").Enabled = True
        '[自定义
        .Buttons("define").Enabled = True
        .Buttons("run").Enabled = True
        '自定义]
    End With
    '[自定义