+

VB开发的ERP系统

  
    '将网格刷新动作解冻
    CzxsGrid.Redraw = True
    
End Sub

Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)           '记录内容填充网格

    Dim Str_Fzhs As String      '辅助核算
    
    '[以下为自定义部分
     With Jlbrec
        
        CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("CClass"))
        CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = .Fields("CodeLevel")
        CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("CCode") & "")
        CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("Cname") & "")
        CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("ForeignCurrName") & "")
        CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("Measure") & "")
        CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("Cproperty") & "")
        Str_Fzhs = ""
        If .Fields("DeptFlag") Then
           Str_Fzhs = Str_Fzhs + "部门 "
        End If
        If .Fields("CusFlag") Then
           Str_Fzhs = Str_Fzhs + "客户 "
        End If
        If .Fields("SupplierFlag") Then
           Str_Fzhs = Str_Fzhs + "供应商 "
        End If
        If .Fields("PersonFlag") Then
           Str_Fzhs = Str_Fzhs + "个人 "
        End If
        If .Fields("ItemFlag") Then
           Str_Fzhs = Str_Fzhs + "项目 "
        End If
        CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)) = Trim(Str_Fzhs)
        CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("AccFormat") & "")
        CzxsGrid.TextMatrix(Rowjsq, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("BalanceOri") & "")
        CzxsGrid.TextMatrix(Rowjsq, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("StopFlag") & "")
        CzxsGrid.TextMatrix(Rowjsq, Sydz("012", GridStr(), Szzls)) = Trim(.Fields("AssCode") & "")
        
     End With
    '以上为自定义部分]

End Sub

Private Sub Form_Unload(Cancel As Integer)             '窗体卸载

    Set Cxnrrec = Nothing
    Set Rec_CodeSet = Nothing
    Unload Dyymctbl
   
End Sub
Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据

    Dim jsqte As Integer
    Dim Str_Parent As String   '上级科目号
    Dim CodeLength As Integer  '录入科目长度
    Dim CodeLev As Integer     '录入科目级次
  
    '对文本框录入内容进行为零和为空判断(固定不变)
    With Rec_CodeSet
        For jsqte = 0 To Max_Text_Index
            If Textint(jsqte, 8) = 1 Then     '字段不能为空
                If Len(Trim(LrText(jsqte).Text)) = 0 Then
                    Tsxx = Textstr(jsqte, 7) & "不能为空!"
                    Call Xtxxts(Tsxx, 0, 1)
                    LrText(jsqte).SetFocus
                    Bclrsj = False
                    Exit Function
                End If
            Else
                If Textint(jsqte, 8) = 2 Then   '字段不能为零
                    If Val(Trim(LrText(jsqte).Text)) = 0 Then
                        Tsxx = Textstr(jsqte, 7) & "不能为零!"
                        Call Xtxxts(Tsxx, 0, 1)
                        LrText(jsqte).SetFocus
                        Bclrsj = False
                        Exit Function
                    End If
                End If
            End If
        Next jsqte
        
        '如有外币核算,则外币栏不能为空
         If Chk_ForiFlag.Value = 1 Then
            If Len(Trim(LrText(2).Text)) = 0 Then
              Tsxx = "科目进行外币核算,则外币项不能为空!"
              Call Xtxxts(Tsxx, 0, 1)
              LrText(2).SetFocus
              Bclrsj = False
              Exit Function
            End If
         End If
        
        '如有数量核算,则数量栏不能为空
         If Chk_QuatFlag.Value = 1 Then
            If Len(Trim(LrText(3).Text)) = 0 Then
              Tsxx = "科目进行数量核算,则数量项不能为空!"
              Call Xtxxts(Tsxx, 0, 1)
              LrText(3).SetFocus
              
              Bclrsj = False
              Exit Function
            End If
         End If
         
         '如有项目核算,则项目类别栏不能为空
         If Chk_Ass(3).Value = 1 Then
            If Len(Trim(LrText(4).Text)) = 0 Then
              Tsxx = "科目进行项目核算,则项目类别项不能为空!"
              Call Xtxxts(Tsxx, 0, 1)
              LrText(4).SetFocus
              Bclrsj = False
              Exit Function
            End If
         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
   
        If Lrzt = 1 Then  '增 加
        
            '判断科目编码是否符合规则,如有效则同时计算科目级次和上级科目编码
            For jsqte = 1 To Int_CodeLev
                If Int_CodeScheme(jsqte) = Len(Trim(LrText(0).Text)) Then
                   CodeLev = jsqte
                   Exit For
                End If
            Next jsqte
            If jsqte <= CodeLev Then
                If jsqte > 1 Then
                   Str_Parent = Mid(Trim(LrText(0).Text), 1, Int_CodeScheme(jsqte - 1))
                Else
                   Str_Parent = ""
                End If
            Else
                Tsxx = "科目编码不符合编码规则!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(0).SetFocus
                Bclrsj = False
                Exit Function
            End If
    
            '判断此科目是否已建立上级科目
            If Str_Parent <> "" Then
                Set Rec_CodeSet = Cw_DataEnvi.DataConnect.Execute("SELECT CCode,StopFlag FROM Cwzz_AccCode  Where CCode='" & Trim(Str_Parent) & "'")
                If Rec_CodeSet.EOF Then
                    Tsxx = "请先建立其上级科目编码!"
                    Call Xtxxts(Tsxx, 0, 1)
                    LrText(0).Text = Str_Parent
                    LrText(0).SelStart = Len(LrText(0).Text)
                    LrText(0).SetFocus
                    Bclrsj = False
                    Exit Function
                Else
                    If Rec_CodeSet.Fields("StopFlag") Then
                        Tsxx = "其上级科目编码已停用,不能建立下级科目!"
                        Call Xtxxts(Tsxx, 0, 1)
                        LrText(0).SetFocus
                        Bclrsj = False
                        Exit Function
                     End If
                End If
                Set RecTemp = Cw_DataEnvi.DataConnect.Execute("SELECT Top 1 CCode FROM Cwzz_AccVouchSub Where CCode='" & Trim(Str_Parent) & "'")
                If Not RecTemp.EOF Then
                    Tsxx = "科目编码(" + Str_Parent + ")已使用,不能建立下级科目!"
                    Call Xtxxts(Tsxx, 0, 1)
                    LrText(0).SelStart = Len(LrText(0).Text)
                    LrText(0).SetFocus
                    Bclrsj = False
                    Exit Function
                End If
            End If

            '[>>判断编码是否重复
            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
                Tsxx = "科目编码重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(0).SetFocus
                Bclrsj = False
                Exit Function
            End If
            
            '判断名称是否重复
            If .State = 1 Then .Close
            .Open "SELECT * FROM Cwzz_AccCode WHERE Cname= '" + Trim(LrText(1).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) + "'", 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
   
            .AddNew
                 .Fields("Cclass") = Combo_Class.Text           '科目类型
                 .Fields("ParentCode") = Str_Parent             '上级科目编码
                 .Fields("Ccode") = Trim(LrText(0).Text)        '科目编码
                 .Fields("AssCode") = Trim(LrText(5).Text)      '助记码
                 .Fields("Cname") = Trim(LrText(1).Text)        '科目名称
                 .Fields("CodeLevel") = CodeLev                 '科目级次
                 .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") = 1
                    .Fields("cSumCode") = Trim(LrText(6).Text)
                 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 Chk_DayBookFlag.Value = 1 Then                 '日记帐
                    .Fields("DayBookFlag") = 1