+

VB开发的ERP系统

                 Else
                    .Fields("DayBookFlag") = 0
                 End If
                 If Chk_CashFlow.Value = 1 Then                 '现金或现金等价物
                    .Fields("CashFlowFlag") = 1
                 Else
                    .Fields("CashFlowFlag") = 0
                 End If
                 .Fields("EndFlag") = 1                         '末级标志
            .Update
            
             '将上级科目末级标志置0
             
             Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Update Cwzz_AccCode Set Endflag=0 Where Ccode='" & Trim(Str_Parent) & "'")
             
             Cw_DataEnvi.DataConnect.CommitTrans
   
            SqlStr = "SELECT Cwzz_AccCode.*, Gy_ForeignCurrency.ForeignCurrName FROM Cwzz_AccCode LEFT OUTER JOIN" & _
                    " Gy_ForeignCurrency ON" & _
                    " Cwzz_AccCode.ForeignCurrCode = Gy_ForeignCurrency.ForeignCurrCode WHERE Ccode= '" & Trim(LrText(0).Text) & "'"
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
   
            With CzxsGrid
                .AddItem ""
                .RowHeight(.Rows - 1) = Sjhgd
                .Select .Rows - 1, Qslz
                Call Jltcwg(Cxnrrec, .Rows - 1)
            End With
   
            Tsxx = "保存完毕!"
            Call Xtxxts(Tsxx, 0, 4)
            Call Cshlrxx(1)
            LrText(0).SetFocus
   
            '将网格按科目编码排序
            With CzxsGrid
                .Col = Sydz("003", GridStr(), Szzls)
                CzxsGrid.Sort = flexSortStringAscending
            End With
    
        Else  '否则为修改记录
 
            If .State = 1 Then .Close
            .Open "SELECT * FROM Cwzz_AccCode WHERE Cname= '" + Trim(LrText(1).Text) + "' and CCode<>'" & Trim(LrText(0).Text) & "'", 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 Trim(LrText(5).Text) <> "" Then
                If .State = 1 Then .Close
                .Open "SELECT * FROM Cwzz_AccCode WHERE AssCode= '" + Trim(LrText(5).Text) + "' and CCode<>'" & Trim(LrText(0).Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                If Not .EOF Then
                    Tsxx = "助记码不唯一!"
                    Call Xtxxts(Tsxx, 0, 1)
                    LrText(5).SetFocus
                    Bclrsj = False
                    Exit Function
                End If
            End If
            
            '如果科目汇总打印则其汇总科目不能为空且为其上级科目
            If Chk_SumPrint.Value = 1 Then
                If Len(Trim(LrText(6).Text)) = 0 Then
                    Tsxx = "科目进行汇总打印,则汇总科目不能为空!"
                    Call Xtxxts(Tsxx, 0, 1)
                    LrText(6).SetFocus
                    Bclrsj = False
                    Exit Function
                Else
                    If InStr(1, Trim(LrText(0).Text), Trim(LrText(6).Text)) = 0 Then
                        Tsxx = "汇总打印科目必须为其上级科目!"
                        Call Xtxxts(Tsxx, 0, 1)
                        LrText(6).SetFocus
                        Bclrsj = False
                        Exit Function
                    End If
                    
                    '判断汇总科目是否存在
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select Ccode From Cwzz_AccCode Where Ccode='" & Trim(LrText(6).Text) & "'")
                    
                    If RecTemp.EOF Then
                        Tsxx = "汇总打印科目不存在!"
                        Call Xtxxts(Tsxx, 0, 1)
                        LrText(6).SetFocus
                        Bclrsj = False
                        Exit Function
                    End If
                End If
            End If
    
            On Error GoTo Swcwcl
    
            Cw_DataEnvi.DataConnect.BeginTrans
     
            If .State = 1 Then .Close
            .Open "SELECT * FROM Cwzz_AccCode WHERE Ccode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If Not .EOF Then
                .Fields("AssCode") = Trim(LrText(5).Text)      '助记码
                .Fields("Cclass") = Combo_Class.Text           '科目类型
                .Fields("Cname") = Trim(LrText(1).Text)        '科目名称
                .Fields("CProperty") = Combo_Prop.Text         '科目性质
                .Fields("AccFormat") = Combo_AccFormat.Text    '帐页格式
                If Chk_ForiFlag.Value = 1 Then                 '外币
                    .Fields("ForeignFlag") = 1
                    .Fields("ForeignCurrCode") = Trim(LrText(2).Tag)
                Else
                    .Fields("ForeignFlag") = 0
                    .Fields("ForeignCurrCode") = Null
                End If
                If Chk_QuatFlag.Value = 1 Then                 '数量单位
                    .Fields("QuantityFlag") = 1
                    .Fields("Measure") = Trim(LrText(3).Text)
                Else
                    .Fields("QuantityFlag") = 0
                    .Fields("Measure") = ""
                End If
                If Chk_SumPrint.Value = 1 Then                 '汇总打印
                    .Fields("IIFSum") = 1
                    .Fields("cSumCode") = Trim(LrText(6).Text)
                Else
                    .Fields("IIFSum") = 0
                    .Fields("cSumCode") = ""
                End If
                If Opt_Yefx(0) Then                            '余额方向
                    .Fields("BalanceOri") = "借"
                Else
                    .Fields("BalanceOri") = "贷"
                End If
            
                If Chk_Ass(0).Value = 1 Then                   '客户核算
                    .Fields("CusFlag") = 1
                Else
                    .Fields("CusFlag") = 0
                End If
                
                If Chk_Ass(4).Value = 1 Then                   '供应商核算
                    .Fields("SupplierFlag") = 1
                Else
                    .Fields("SupplierFlag") = 0
                End If
                
                If Chk_Ass(1).Value = 1 Then                   '部门核算
                    .Fields("DeptFlag") = 1
                Else
                    .Fields("DeptFlag") = 0
                End If
                
                If Chk_Ass(2).Value = 1 Then                   '个人核算
                    .Fields("PersonFlag") = 1
                Else
                    .Fields("PersonFlag") = 0
                End If
                If Chk_Ass(3).Value = 1 Then                   '项目核算
                    .Fields("ItemFlag") = 1
                    .Fields("ItemClassCode") = Trim(LrText(4).Tag)
                Else
                    .Fields("ItemFlag") = 0
                    .Fields("ItemClassCode") = Null
                End If
                   
                If ChkStopUse.Value = 1 Then                   '停用
                    .Fields("StopFlag") = 1
                Else
                    .Fields("StopFlag") = 0
                End If
                
                If Chk_DayBookFlag.Value = 1 Then                 '日记帐
                    .Fields("DayBookFlag") = 1
                Else
                    .Fields("DayBookFlag") = 0
                End If
                
                If Chk_CashFlow.Value = 1 Then                 '现金或现金等价物
                    .Fields("CashFlowFlag") = 1
                Else
                    .Fields("CashFlowFlag") = 0
                End If
             
                .Update
      
                '修改其下级科目科目类型
                SqlStr = "Update Cwzz_AccCode Set Cclass='" & Combo_Class.Text & "' Where Ccode Like  '" & Trim(LrText(0).Text) & "%'"
                Cw_DataEnvi.DataConnect.Execute (SqlStr)
      
            End If
  
            Cw_DataEnvi.DataConnect.CommitTrans
     
            SqlStr = "SELECT Cwzz_AccCode.*, Gy_ForeignCurrency.ForeignCurrName FROM Cwzz_AccCode LEFT OUTER JOIN" & _
                    " Gy_ForeignCurrency ON" & _
                    " Cwzz_AccCode.ForeignCurrCode = Gy_ForeignCurrency.ForeignCurrCode WHERE Ccode= '" & Trim(LrText(0).Text) & "'"
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
            
            If Not Cxnrrec.EOF Then
                With CzxsGrid
                    Call Jltcwg(Cxnrrec, .Row)
                End With
            End If
  
  End If
  
  '保存记录成功,函数返回真值
  Bclrsj = True
  Exit Function
    
End With

Swcwcl:

    Cw_DataEnvi.DataConnect.RollbackTrans
    
    Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    
    Exit Function
     
End Function

Private Function Cshlrxx(lrztxx As Integer) As Boolean              '初始化录入字段信息

    TextChangeLock = True       '关闭文本框Chang事件
    
    If lrztxx = 1 Then
    
        '增加新记录时将文本框清空
        For jsqte = 0 To Max_Text_Index
            If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
                LrText(jsqte).Text = ""
                LrText(jsqte).Tag = ""
            End If
            TextValiJudgeLock(jsqte) = True
        Next jsqte
       
        '[>>
        '在此处可添加新增记录时初始化设置
        Chk_ForiFlag.Value = 0
        Chk_QuatFlag.Value = 0
        Chk_SumPrint.Value = 0
        ChkStopUse.Value = 0
        Opt_Yefx(0).Value = True
        For jsqte = 0 To 3
            Chk_Ass(jsqte).Value = 0
        Next jsqte
     
        ChkStopUse.Enabled = False
        '<<]
    Else
    
        '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
        SqlStr = "SELECT Cwzz_AccCode.*, Gy_ForeignCurrency.ForeignCurrName,Cwzz_ItemClass.ItemClassName FROM Cwzz_AccCode LEFT OUTER JOIN" & _
                " Gy_ForeignCurrency ON" & _
                " Cwzz_AccCode.ForeignCurrCode = Gy_ForeignCurrency.ForeignCurrCode LEFT OUTER JOIN" & _
                " Cwzz_ItemClass ON" & _
                " Cwzz_AccCode.ItemClassCode = Cwzz_ItemClass.ItemClassCode  Where CCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("003", GridStr(), Szzls))) & "'"
 
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
       
        If Not RecTemp.EOF Then
           
                LrText(0).Text = Trim(RecTemp.Fields("Ccode"))                 '科目编码
                LrText(5).Text = Trim(RecTemp.Fields("AssCode") & "")          '助记码
                LrText(1).Text = Trim(RecTemp.Fields("Cname") & "")            '科目名称
                Combo_Class.Text = Trim(RecTemp.Fields("CClass"))              '科目类型
                Combo_Prop.Text = Trim(RecTemp.Fields("CProperty"))            '科目性质
                Combo_AccFormat = Trim(RecTemp.Fields("AccFormat"))            '帐页格式
                
                If RecTemp.Fields("ForeignFlag") Then
                    Chk_ForiFlag.Value = 1                                         '外币核算标志
                    LrText(2).Text = Trim(RecTemp.Fields("ForeignCurrName") & "")
                    LrText(2).Tag = Trim(RecTemp.Fields("ForeignCurrCode") & "")
                    Call Textyx(LrText(2))
                    Ydcommand1(2).Enabled = True
                Else
                    Chk_ForiFlag.Value = 0
                    LrText(2).Text = ""
                    LrText(2).Tag = ""
                    Call Textwx(LrText(2))
                    Ydcommand1(2).Enabled = False
                End If
                    
                If RecTemp.Fields("QuantityFlag") Then
                    Chk_QuatFlag.Value = 1                                          '数量核算标志
                    LrText(3).Text = Trim(RecTemp.Fields("Measure") & "")
                    Call Textyx(LrText(3))
                Else
                    Chk_QuatFlag.Value = 0
                    Call Textwx(LrText(3))
                    LrText(3).Text = ""
                End If
                
                If RecTemp.Fields("IIFSum") Then
                    Chk_SumPrint.Value = 1                                          '汇总打印
                    LrText(6).Text = Trim(RecTemp.Fields("cSumCode") & "")
                    Call Textyx(LrText(6))
                Else
                    Chk_SumPrint.Value = 0
                    Call Textwx(LrText(6))
                    LrText(6).Text = ""
                End If
                
                If Trim(RecTemp.Fields("BalanceOri")) = "借" Then                  '余额方向
                   Opt_Yefx(0).Value = True
                Else
                   Opt_Yefx(1).Value = True
                End If
                
                If RecTemp.Fields("CusFlag") Then
                    Chk_Ass(0).Value = 1                                           '辅助核算(客户)
                Else
                    Chk_Ass(0).Value = 0
                End If