VB开发的ERP系统

            End If
    
            If .State = 1 Then .Close
            .Open "SELECT * FROM Gy_Supplier WHERE suppliername= '" + Trim(LrText(1).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    

            '判断记录内容无误后,将记录内容写入数据表
            On Error GoTo Swcwcl
    
            Cw_DataEnvi.DataConnect.BeginTrans
   
            .AddNew
            .Fields("suppliercode") = Trim(LrText(0).Text)      '供应商编码
            .Fields("suppliername") = Trim(LrText(1).Text)      '供应商名称
            .Fields("supplierforshort") = Trim(LrText(2))       '简称
            .Fields("suppliersort") = Trim(LrText(3).Tag)       '所属分类
            If Trim(LrText(4).Tag) <> "" Then
                .Fields("areacode") = Trim(LrText(4).Tag)       '地区编码
            Else
                .Fields("areacode") = Null
            End If
            If Trim(LrText(5).Tag) <> "" Then
                .Fields("tradecode") = Trim(LrText(5).Tag)      '行业编码
            Else
                .Fields("tradecode") = Null
            End If
            .Fields("address") = Trim(LrText(6))                '地址
            .Fields("postcode") = Trim(LrText(7))               '邮政编码
            .Fields("taxpayer") = Trim(LrText(8).Text)          '纳税人登记号
            .Fields("bank") = Trim(LrText(9).Text)              '开户银行
            .Fields("BankAccount") = Trim(LrText(10).Text)      '银行账号
            If IsDate(Trim(LrText(11).Text)) Then               '发展日期
                .Fields("relationdate") = Trim(LrText(11).Text)
            Else
                .Fields("relationdate") = Null
            End If
            .Fields("fictperson") = Trim(LrText(12).Text)       '法人
            .Fields("email") = Trim(LrText(13).Text)
            .Fields("creditgrade") = Trim(LrText(14).Text)      '信用等级
            .Fields("worknet") = Trim(LrText(15).Text)          '网址
            
            .Fields("contactperson") = Trim(LrText(16).Text)    '联系人
            .Fields("contacttype") = Trim(LrText(17).Text)      '联系方式
            If Trim(LrText(18).Text) <> "" Then
                .Fields("rpacccode") = Trim(LrText(18).Tag)     '付款科目
            Else
                .Fields("rpacccode") = Null
            End If
            If Trim(LrText(19).Text) <> "" Then
                .Fields("apacccode") = Trim(LrText(19).Tag)     '应付科目
            Else
                .Fields("apacccode") = Null
            End If
            If Trim(LrText(20).Text) <> "" Then
                .Fields("ppacccode") = Trim(LrText(20).Tag)     '预付科目
            Else
                .Fields("ppacccode") = Null
            End If
            .Fields("payment") = Val(LrText(21).Text)           '应付余额
            If IsDate(Trim(LrText(22).Text)) Then               '最后付款日期
                .Fields("lastpaymentdate") = Trim(LrText(22).Text)
            Else
                .Fields("lastpaymentdate") = Null
            End If
            .Fields("lastpaymentmoney") = Val(LrText(23))       '最后付款金额
'
            If LrCheck(0).Value Then    '是否通过质量认证
                .Fields("isRz") = 1
            Else
                .Fields("isrz") = 0
            End If
            If LrCheck(1).Value Then    '评估标志
                .Fields("evalflag") = 1
            Else
                .Fields("evalflag") = 0
            End If
            If LrCheck(2).Value Then    '停用标志
                .Fields("stopflag") = 1
            Else
                .Fields("stopflag") = 0
            End If
            .Update
            Cw_DataEnvi.DataConnect.CommitTrans

            '将记录加入网格
            Sqlstr = "SELECT * FROM Gy_V_Supplier WHERE suppliercode= '" + 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("001", GridStr(), Szzls)
                CzxsGrid.Sort = flexSortStringAscending
            End With
            '<<]
    
        Else  '否则为修改记录
 
        '******************************************
        '计算供应商名称相似率（相同字的个数/长度）
        If str_SupplierName <> Trim(LrText(1)) Then '如果供应商名称有改变
            likenum = 0
            j = 0
            'rs用于取出相似率
            rs.Open "select itemvalue from gy_accinformation where itemcode='gy_supplier'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            
            If .State = 1 Then .Close
            .Open "SELECT suppliername FROM gy_supplier where suppliercode<>'" & Trim(LrText(0).Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            str_tmp = Trim(LrText(1))
            Do While Not .EOF
                For I = 1 To Len(str_tmp)
                    If InStr(1, Trim(.Fields("suppliername")), Mid(str_tmp, I, 1)) Then
                        likenum = likenum + 1
                    End If
                Next
                
                If likenum * 100# / Len(str_tmp) > Val(rs("itemvalue")) Then
                    suppliername = suppliername & "        " & Trim(.Fields("suppliername")) & "     " & Chr(13)
                End If
                likenum = 0
                .MoveNext
            Loop
            If Len(suppliername) > 0 Then
                Tsxx = "存在相似的供应商名称:" & Chr(13) & suppliername & "要继续吗?"
                If Xtxxts(Tsxx, 1, 2) = vbNo Then
                    LrText(1).SetFocus
                    Bclrsj = False
                    Exit Function
                End If
            End If
            Set rs = Nothing
        End If
       '****************************************************

            On Error GoTo Swcwcl

            Cw_DataEnvi.DataConnect.BeginTrans

            If .State = 1 Then .Close
            .Open "SELECT * FROM Gy_Supplier WHERE suppliercode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
     
            If Not .EOF Then
                .Fields("suppliername") = Trim(LrText(1).Text)      '供应商名称
                .Fields("supplierforshort") = Trim(LrText(2))       '简称
                .Fields("suppliersort") = Trim(LrText(3).Tag)       '所属分类
                If Trim(LrText(4).Tag) <> "" Then
                    .Fields("areacode") = Trim(LrText(4).Tag)       '地区编码
                Else
                    .Fields("areacode") = Null
                End If
                If Trim(LrText(5).Tag) <> "" Then
                    .Fields("tradecode") = Trim(LrText(5).Tag)      '行业编码
                Else
                    .Fields("tradecode") = Null
                End If
                .Fields("address") = Trim(LrText(6))                '地址
                .Fields("postcode") = Trim(LrText(7))               '邮政编码
                .Fields("taxpayer") = Trim(LrText(8).Text)          '纳税人登记号
                .Fields("bank") = Trim(LrText(9).Text)              '开户银行
                .Fields("BankAccount") = Trim(LrText(10).Text)      '银行账号
                If IsDate(Trim(LrText(11).Text)) Then               '发展日期
                    .Fields("relationdate") = Trim(LrText(11).Text)
                Else
                    .Fields("relationdate") = Null
                End If
                .Fields("fictperson") = Trim(LrText(12).Text)       '法人
                .Fields("email") = Trim(LrText(13).Text)
                .Fields("creditgrade") = Trim(LrText(14).Text)      '信用等级
                .Fields("worknet") = Trim(LrText(15).Text)          '网址
                
                .Fields("contactperson") = Trim(LrText(16).Text)    '联系人
                .Fields("contacttype") = Trim(LrText(17).Text)      '联系方式
                If Trim(LrText(18).Text) <> "" Then
                    .Fields("rpacccode") = Trim(LrText(18).Tag)     '付款科目
                Else
                    .Fields("rpacccode") = Null
                End If
                If Trim(LrText(19).Text) <> "" Then
                    .Fields("apacccode") = Trim(LrText(19).Tag)     '应付科目
                Else
                    .Fields("apacccode") = Null
                End If
                If Trim(LrText(20).Text) <> "" Then
                    .Fields("ppacccode") = Trim(LrText(20).Tag)     '预付科目
                Else
                    .Fields("ppacccode") = Null
                End If
                .Fields("payment") = Val(LrText(21).Text)           '应付余额
                If IsDate(Trim(LrText(22).Text)) Then               '最后付款日期
                    .Fields("lastpaymentdate") = Trim(LrText(22).Text)
                Else
                    .Fields("lastpaymentdate") = Null
                End If
                .Fields("lastpaymentmoney") = Val(LrText(23))       '最后付款金额
    '
                If LrCheck(0).Value Then   '是否通过质量认证
                    .Fields("isRz") = 1
                Else
                    .Fields("isrz") = 0
                End If
                If LrCheck(1).Value Then   '评估标志
                    .Fields("evalflag") = 1
                Else
                    .Fields("evalflag") = 0
                End If
                If LrCheck(2).Value Then   '停用标志
                    .Fields("stopflag") = 1
                Else
                    .Fields("stopflag") = 0
                End If
                .Update
            End If

             Cw_DataEnvi.DataConnect.CommitTrans
   
            '刷新当前网格
            Sqlstr = "SELECT * FROM Gy_V_Supplier WHERE suppliercode= '" + Trim(LrText(0).Text) + "'"
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
   
            With CzxsGrid
                Call Jltcwg(Cxnrrec, .Row)
            End With
   
        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              '初始化录入字段信息
    Dim RecTemp As New ADODB.Recordset
    TextChangeLock = True       '关闭文本框Chang事件
    Call mmkn
    str_SupplierName = ""
    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
    
        '[>>
        '在此处可添加新增记录时初始化设置
        '<<]
    Else
    
        '修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
        With RecTemp
            Sqlstr = "SELECT * FROM Gy_V_Supplier Where suppliercode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) & "'"

            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
       
            '记录如存在则读入其内容,否则提示记录已被其他人删除
            If Not RecTemp.EOF Then
                Call ShowData(RecTemp)
            Else
                Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
                Call Xtxxts(Tsxx, 0, 4)
                Call Cancel
                TextChangeLock = False
                Exit Function
            End If
        End With
    End If
    
    Cshlrxx = True
    TextChangeLock = False
    
End Function
Private Sub ShowData(rs As ADODB.Recordset)
    With rs
        LrText(0) = Trim(.Fields("suppliercode") & "")                  '供应商编码
        LrText(1) = Trim(.Fields("suppliername") & "")                  '供应商名称
        LrText(2) = Trim(.Fields("supplierforshort") & "")              '供应商简称
        LrText(3) = Trim(.Fields("suppliersortname") & "")              '分类
        LrText(4) = Trim(.Fields("areaname") & "")                      '地区
        LrText(5) = Trim(.Fields("tradename") & "")                     '行业
        LrText(6) = Trim(.Fields("address") & "")                       '地址
        LrText(7) = Trim(.Fields("postcode") & "")                      '邮政编码
        LrText(8) = Trim(.Fields("taxpayer") & "")                      '纳税人登记号
        LrText(9) = Trim(.Fields("bank") & "")                          '开户银行
        LrText(10) = Trim(.Fields("BankAccount") & "")                  '银行账号
        LrText(11) = Format(.Fields("relationdate") & "", "yyyy-mm-dd") '发展日期                   '发展日期
        LrText(12) = Trim(.Fields("fictperson"))                        '法人
        LrText(13) = Trim(.Fields("email") & "")                        'email
        LrText(14) = Trim(.Fields("creditgrade") & "")                  '信用等级
        LrText(15) = Trim(.Fields("worknet") & "")                      '网址
        LrText(16) = Trim(.Fields("contactperson") & "")                '联系人
        LrText(17) = Trim(.Fields("contacttype") & "")                  '联系方式
        LrText(18) = Trim(.Fields("rpaccname")