VB开发的ERP系统

                .Buttons("sc").Enabled = False      '删除
                .Buttons("zh").Enabled = True       '增行
                .Buttons("sh").Enabled = True       '删行
                .Buttons("bc").Enabled = True       '保存
                .Buttons("fq").Enabled = True       '放弃
                .Buttons("shsh").Enabled = False    '审核
                .Buttons("shqs").Enabled = False    '弃审
                .Buttons("dk").Enabled = False      '打开
                .Buttons("gb").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)
            Case "30"   '修改(（录入）调入修改功能、（列表）调入修改功能)
                '工具条
                .Buttons("dy").Enabled = False      '打印
                .Buttons("yl").Enabled = False      '预览
                .Buttons("xz").Enabled = False      '新增
                .Buttons("xg").Enabled = False      '修改
                .Buttons("sc").Enabled = False      '删除
                .Buttons("zh").Enabled = True       '增行
                .Buttons("sh").Enabled = True       '删行
                .Buttons("bc").Enabled = True       '保存
                .Buttons("fq").Enabled = True       '放弃
                .Buttons("shsh").Enabled = False    '审核
                .Buttons("shqs").Enabled = False    '弃审
                .Buttons("dk").Enabled = False      '打开
                .Buttons("gb").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)
        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(19).Text) <> "" And Trim(LrText(20).Text) = "" Then
        Tlb_Action.Buttons("shsh").Enabled = True      '审核
    Else
        Tlb_Action.Buttons("shsh").Enabled = False   '审核
    End If
    If Trim(LrText(19).Text) <> "" And Trim(LrText(20).Text) <> "" Then
        Tlb_Action.Buttons("shqs").Enabled = True      '弃审
    Else
        Tlb_Action.Buttons("shqs").Enabled = False   '弃审
    End If

End Sub
Private Sub Sub_OpenStatus()                                       '设置打开关闭按钮状态(亦可设置其他动作按钮状态)
    
    '根据当前单据状态来确定打开关闭按钮状态
    If Trim(LrText(19).Text) <> "" And Trim(LrText(21).Text) <> "" Then
        Tlb_Action.Buttons("dk").Enabled = True      '打开
    Else
        Tlb_Action.Buttons("dk").Enabled = False   '打开
    End If
    If Trim(LrText(19).Text) <> "" And Trim(LrText(21).Text) = "" Then
        Tlb_Action.Buttons("gb").Enabled = True      '关闭
    Else
        Tlb_Action.Buttons("gb").Enabled = False   '关闭
    End If
    
End Sub

Private Sub Sub_ReadQuotation()
Dim strTemp As String
Dim RsTemp As New ADODB.Recordset
Dim Jsqte As Long

    strTemp = "select * from Xs_V_Quotation where Quotationcode= '" & LrText(2).Text & "' order by QuotationMainID,Quotationsubid"
    Set RsTemp = Cw_DataEnvi.DataConnect.Execute(strTemp)
    With RsTemp
        If .RecordCount = 0 Then
            Tsxx = "此报价单号不存在!"
            Call Xtxxts(Tsxx, 0, 4)
            Call Sub_AddBill
            Exit Sub
        Else
            If Trim(.Fields("closer")) <> "" Or Trim(.Fields("checker")) = "" Then
                Tsxx = "此报价单已经被关闭或未被审核!"
                Call Xtxxts(Tsxx, 0, 4)
                Call Sub_AddBill
                Exit Sub
            End If
        End If
            TextChangeLock = True     '文本框加锁
            LrText(2).Tag = Val(.Fields("QuotationMainID") & "")                '报价单ID
            LrText(2).Text = Trim(.Fields("QuotationCode") & "")                '报价单号
            LrText(3).Tag = Trim(.Fields("cusCode") & "")                       '客户编码
            LrText(3).Text = Trim(.Fields("cusname") & "")
            LrText(4).Tag = Trim(.Fields("SellTypeCode") & "")                  '销售类型
            LrText(4).Text = Trim(.Fields("SellTypename") & "")
            LrText(5).Tag = Trim(.Fields("deptCode") & "")                      '部门编码
            LrText(5).Text = Trim(.Fields("deptname") & "")
            LrText(6).Tag = Trim(.Fields("personCode") & "")                    '销售员
            LrText(6).Text = Trim(.Fields("personname") & "")
            LrText(7).Tag = Trim(.Fields("foreigncurrcode") & "")               '币种
            LrText(7).Text = Trim(.Fields("foreigncurrname") & "")
            LrText(8).Text = Trim(.Fields("exchrate") & "")                     '汇率
            LrText(9).Tag = ""                                                  '合同类别
            LrText(9).Text = ""
            LrText(10).Text = ""                                                '("客户签约人")
            LrText(11).Text = ""                                                '("公司签约人")
            LrText(12).Text = ""                                                '("签约地址")
            LrText(13).Text = Trim(.Fields("consignaddress") & "")              '("发货地址")
            LrText(14).Text = Trim(.Fields("Payname") & "")                     '("付款方式")
            LrText(14).Tag = Trim(.Fields("PayCode") & "")                      '("付款方式代码")
            LrText(15).Text = Trim(.Fields("TransferWayName") & "")             '("发运方式")
            LrText(15).Tag = Trim(.Fields("TransferWayCode") & "")              '("发运方式代码")
            LrText(16).Text = ""                                                '("定金")
            LrText(17).Text = ""                                                '合同到期日
            LrText(18).Text = Trim(.Fields("Remark") & "")                      '("备注")
            LrText(19).Text = Trim(.Fields("Maker") & "")                       '("制单人")
            LrText(20).Text = ""                                                '("审核人")
            LrText(21).Text = ""                                                '("关闭人")
            
            TextChangeLock = False    '文本框解锁
            
        Jsqte = WglrGrid.FixedRows
        Do While Not .EOF
            WglrGrid.AddItem ""
            '[>>显示单据分录
            WglrGrid.TextMatrix(Jsqte, 0) = "*"                          '数据有效行标识(必填)
            WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("WareCode") & "")                  '存货编码
            WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("MName") & "")                     '存货名称
            WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("Model") & "")                     '存货规格
            WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("SaleUnitName") & "")              '存货单位
            WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("Quantity") & "")                  '存货数量
            WglrGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("TaxUnitPrice") & "")              '存货含税单价
            WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("TaxMoney") & "")                  '存货税额
            WglrGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("TaxRate") & "")                   '存货税率
            WglrGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("WholeMoney") & "")                '存货总金额
            WglrGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("UnitPrice") & "")                 '存货无税单价
            WglrGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("QuotationMoney") & "")            '存货无税金额
            If Year(Trim(.Fields("PrePareDate") & "")) = "1900" Then
                WglrGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = ""
            Else
                WglrGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = Format(.Fields("PrePareDate"), "yyyy-mm-dd")                '预发货日期
            End If
            WglrGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = Trim(.Fields("Remarksub") & "")                    '存货备注
            '<<]
                   
            WglrGrid.RowHeight(Jsqte) = Sjhgd
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With
    LrText(3).Enabled = False
    '计算合计数据(Fixed)
    For Jsqte = Qslz To WglrGrid.Cols - 1
        Call Sjhj(Jsqte)
    Next Jsqte
End Sub



Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
    
    Dim xswbrr As String
    With WglrGrid
        Zdlrqnr = Trim(.Text)
        xswbrr = Trim(.Text)
        If GridBoolean(.Col, 3) Then   '列表框录入
            '填充列表框程序
            Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
        Else
            Wbkbhlock = True
       
            '====以下为用户自定义
            Ydtext.Text = xswbrr
            '====以上为用户自定义
         
            Wbkbhlock = False
            Ydtext.SelStart = Len(Ydtext.Text)
        End If
    End With

End Sub

Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
 
    '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值

    Dim Str_JudgeText As String                 '临时有效性判断字段内容
    Dim Coljsq As Long                          '临时列计数器
    Dim RecTemp As New ADODB.Recordset          '临时使用动态集
    Dim Sqlstr As String                        '临时使用查询字符串
    Dim Jsq As Integer
    With WglrGrid
        '非录入状态或非数据行则其有效性为合法
        If Yxxpdlock Or .Row < .FixedRows Then
            sjzdyxxpd = True
            Exit Function
        End If
        
        '取得当前要判断字段内容
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
      
        '根据不同字段进行相应的处理(依据其逻辑编号)
        Select Case GridStr(Dqpdwgl, 1)
            '[>>以下为自定义部分
            Case "001"                   '存货编码
                If Not Trim(Str_JudgeText) = "" Then
                    '1.放置字段有效性判断
                    Sqlstr = "SELECT MNumber,MName,Model,SaleUnitName,ConsultPrice,Cess From Gy_Material Where (MNumber='" & Str_JudgeText & "' Or MName='" & Str_JudgeText & "') and isSale='1'"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    If RecTemp.EOF Then
                        Tsxx = "此存货编码不存在!"
                        GoTo Lrcwcl
                    End If
                    For Jsq = .FixedRows To .Cols - 1
                        If .TextMatrix(Jsq, 0) <> "*" Then
                            Exit For
                        End If
                        If Jsq <> Dqpdwgh Then
                            If Trim(.TextMatrix(Jsq, Sydz("001", GridStr(), Szzls))) = Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))) Then
                                Tsxx = "不能重复录入货物编码!"
                                GoTo Lrcwcl
                            End If
                        End If
                    Next
                    '2.放置字段事后处理程序
                    .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("MNumber") & "")      '显示存货编码
                    .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("MName") & "")      '显示存货名称
                    .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("Model") & "")     '显示存货规格型号
                    .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = RecTemp.Fields("SaleUnitName")              '单位
                    If LrText(7) <> "" Then
                        If LrText(8).Tag <> "1" Or LrText(8).Tag = True Then
                            .TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = Format(Val(RecTemp.Fields("ConsultPrice")) / LrText(8).Text, "###0." + String(Xtdjxsws, "0"))             '单价
                        Else
                            .TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = Format(Val(RecTemp.Fields("ConsultPrice")) * LrText(8).Text, "###0." + String(Xtdjxsws, "0"))           '单价
                        End If
                    End If
                    .TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls)) = RecTemp.Fields("Cess") / 100                  '税率
                    '根据公式计算结果
                    .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = 1
                    Call Sub_JoinCount(Dqpdwgh, Sydz("005", GridStr(), Szzls))   '数量
                Else
                    '3.清空相关字段
                    .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = ""                                             '存货名称
                    .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = ""                                             '存货规格型号
                End If
            Case "006"          '单价
                '1.放置字段有效性判断
                
                '2.放置字段事后