VB开发的ERP系统

                Ydcommand.Visible = True
            Else
                Ydcommand.Visible = False
            End If
            Ydtext.Left = .CellLeft + .Left + Wbkpy
            Ydtext.Top = .CellTop + .Top + Wbkpy
            If Ydcommand.Visible Then
                If Sfblbzkd Then
                    Ydtext.Width = .CellWidth - Ydcommand.Width
                Else
                    Ydtext.Width = .CellWidth - Wbkpy1
                End If
            Else
                Ydtext.Width = .CellWidth - Wbkpy1
            End If
            Ydtext.Height = .CellHeight - Wbkpy1
            If GridInt(.Col, 2) <> 0 Then
                Ydtext.MaxLength = GridInt(.Col, 2)
            Else
                Ydtext.MaxLength = 3000
            End If
            ' 主要是Zdlrqnr = Trim(.Text)即将网格单元的内容赋予文本框，并且记录网格编辑之前的内容
            '为是否对该单元的内容进行字段有效判断加锁Yxxpdlock = False
            Call Wbkcl
            Ydtext.Visible = True
            Ydtext.SetFocus
        End If
        Dqtoprow = .TopRow
        Dqleftcol = .LeftCol
        
        '重置锁值
        Valilock = False
        Wbkbhlock = False
    End With
End Sub

Private Sub Lrsjhx()                                                   '文本框录入数据回写
    With WglrGrid
        If YdCombo.Visible Then .Text = Trim(YdCombo.Text)
        If Ydtext.Visible Then .Text = Trim(Ydtext.Text)
        
        '(如果字段录入内容发生变化,则打开有效性判断锁)
        If Zdlrqnr <> Trim(.Text) Then
            Yxxpdlock = False
            Hyxxpdlock = False
        End If
        '如果字段录入内容不为空则写数据行有效性标志
        If Len(Trim(.Text)) <> 0 Then
            Call Xyxhbz(.Row)
        End If
        '隐藏文本框,帮助按钮,列表组合框
        Call Ycwbk
    End With
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)        '录入数据字段有效性判断,同时进行字段录入事后处理
    Dim Str_JudgeText As String  '临时有效性判断字段内容
    Dim Coljsq As Long           '临时列计数器
    
    With WglrGrid
        '非录入状态有效性为合法
        If Yxxpdlock Or .Row < .FixedRows Then
            sjzdyxxpd = True
            Exit Function
        End If
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
    End With
    Select Case GridStr(Dqpdwgl, 1)
        '以下为自定义部分[
    Case "005"     '转帐性质
        If Len(Str_JudgeText) <> 0 Then
            If Str_JudgeText <> "转入" And Str_JudgeText <> "转出" Then
                Tsxx = "转帐方向必须选择“转入”或“转出”"
                GoTo Lrcwcl
            End If
        End If
    Case "001"          '凭证摘要(如用户录入编码正确,则自动调入摘要内容)
        If Len(Str_JudgeText) <> 0 Then
            Sqlstr = "SELECT * FROM Cwzz_Digest Where DigestCode='" & Str_JudgeText & "'"
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If Not RecTemp.EOF Then
                WglrGrid.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("DigestText"))
            End If
            '保存最后录入的一条凭证分录的摘要内容
            Str_Digest = WglrGrid.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))
        End If
    Case "002"
        If Len(Str_JudgeText) <> 0 Then
            Sqlstr = "Select Cwzz_AccCode.* ,ItemClassName FROM  Cwzz_AccCode " & _
            " LEFT OUTER JOIN Cwzz_ItemClass ON Cwzz_AccCode.ItemClassCode = Cwzz_ItemClass.ItemClassCode " & _
            " Where Ccode='" & Str_JudgeText & "' OR AssCode='" & Str_JudgeText & "'"
            '可以建外键,为何?
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            With RecTemp
                If .EOF Then
                    Tsxx = "此科目不存在!"
                    GoTo Lrcwcl
                Else
                    If Not .Fields("EndFlag") Then
                        Tsxx = "此科目非末级科目!"
                        GoTo Lrcwcl
                    End If
                    If .Fields("StopFlag") Then
                        Tsxx = "此科目已停用"
                        GoTo Lrcwcl
                    End If
                    '如果此科目存在且改变过则执行下列操作
                    '1.显示科目编码,改变科目名称
                    WglrGrid.TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("Ccode"))
                    WglrGrid.TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("Cname"))
                    '                        WglrGrid.TextMatrix(Dqpdwgh, 9) = Trim(rectemp.Fields("ItemClassCode") & "")
                    '                        WglrGrid.TextMatrix(Dqpdwgh, 10) = Trim(rectemp.Fields("ItemClassName") & "")
                    Call Sub_Drfzhsx(Dqpdwgh, Str_JudgeText)
                End If
            End With
        Else
            For Jsqte = 1 To 12
                WglrGrid.TextMatrix(Dqpdwgh, Jsqte) = ""
            Next Jsqte
            WglrGrid.TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = ""
        End If
    End Select
    '字段录入正确后为零字段清空
    Call Qkwlzd(Dqpdwgh, Dqpdwgl)
    sjzdyxxpd = True
    Yxxpdlock = True
    Exit Function
Lrcwcl:    '录入错误处理
    With WglrGrid
        Call Xtxxts(Tsxx, 0, 1)
        changelock = True
        .Select Dqpdwgh, Dqpdwgl
        If GridBoolean(.Col, 1) = True Then
            changelock = False
            Call xswbk
            sjzdyxxpd = False
        Else
            If Help_Bz_Col(.Col) = True And Lab_OperStatus.Caption = 3 Then
                Call Yd_Help_Show
            End If
        End If
    End With
    Exit Function
End Function

Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
    Dim Lrywlz As Long
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Bln_AssVali As Boolean             '辅助核算错误
    Dim Bj As Boolean                       '辅助项有效性标志
    With WglrGrid
        
        '判断行是否为空和无效数据行清除
        If Yxxpdh > (.Rows - .FixedRows) Then Exit Function
        If .TextMatrix(Yxxpdh, 0) <> "*" Then
            Sjhzyxxpd = True
            Exit Function
        Else
            If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
                If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
                    changelock = True
                    .RemoveItem Yxxpdh
                    If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
                        .AddItem ""
                        .RowHeight(.Rows - 1) = Sjhgd
                    End If
                    changelock = False
                    Sjhzyxxpd = True
                    Exit Function
                End If
            End If
        End If
        
        '行没有发生变化则不进行有效性判断
        If Hyxxpdlock Then
            Sjhzyxxpd = True
            Exit Function
        End If
        
        '以下为自定义部分[
        '1.放置行有效性判断程序
        
        '首先进行为空判断(固定不变)
        For Jsqte = Qslz To .Cols - 1
            If (GridInt(Jsqte, 5) = 1 And Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0) Or (GridInt(Jsqte, 5) = 2 And Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0) Then
                Tsxx = GridStr(Jsqte, 2)
                Lrywlz = Jsqte
                GoTo Lrcwcl
                Exit For
            End If
        Next Jsqte
        
        '判断辅助核算项目是否已填写，且有效
        If Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls))) <> "" Then
            Sqlstr = "Select * FROM Cwzz_AccCode Where Ccode='" & Trim(.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls))) & "'"
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            Lrywlz = Sydz("002", GridStr(), Szzls)
            If Not RecTemp.EOF Then
                '部门核算则部门不能为空,且有效
                If RecTemp.Fields("DeptFlag") Then
                    If Len(Trim(WglrGrid.TextMatrix(Yxxpdh, 3))) = 0 Then
                        Tsxx = "该转帐科目需要部门核算,部门项不能为空"
                        Bln_AssVali = True
                        GoTo Lrcwcl
                    End If
                Else
                    .TextMatrix(Yxxpdh, 3) = ""
                    .TextMatrix(Yxxpdh, 4) = ""
                End If
                '客户单位核算则往来单位不能为空,且有效
                
                If RecTemp.Fields("CusFlag") Then
                    If Len(Trim(WglrGrid.TextMatrix(Yxxpdh, 5))) = 0 Then
                        Tsxx = "该转帐科目需要客户单位核算,客户单位项不能为空"
                        Bln_AssVali = True
                        GoTo Lrcwcl
                    End If
                Else
                    .TextMatrix(Yxxpdh, 5) = ""
                    .TextMatrix(Yxxpdh, 6) = ""
                End If
                '供应商单位核算则供应商单位不能为空
                If RecTemp.Fields("SupplierFlag") Then
                    If Len(Trim(WglrGrid.TextMatrix(Yxxpdh, 7))) = 0 Then
                        Tsxx = "该转帐科目需要供应商单位核算,供应商单位项不能为空"
                        Bln_AssVali = True
                        GoTo Lrcwcl
                    End If
                Else
                    .TextMatrix(Yxxpdh, 7) = ""
                    .TextMatrix(Yxxpdh, 8) = ""
                    
                End If
                
                '个人往来核算则个人项不能为空
                If RecTemp.Fields("PersonFlag") Then
                    If Len(Trim(WglrGrid.TextMatrix(Yxxpdh, 1))) = 0 Then
                        Tsxx = "该转帐科目需要个人往来核算,个人项不能为空"
                        Bln_AssVali = True
                        GoTo Lrcwcl
                    End If
                Else
                    .TextMatrix(Yxxpdh, 1) = ""
                    .TextMatrix(Yxxpdh, 2) = ""
                End If
                
                '项目核算则项目不能为空
                If RecTemp.Fields("ItemFlag") Then
                    If Len(Trim(WglrGrid.TextMatrix(Yxxpdh, 11))) = 0 Then
                        Tsxx = "该转帐科目需要项目核算,核算项目不能为空"
                        Bln_AssVali = True
                        GoTo Lrcwcl
                    End If
                Else
                    .TextMatrix(Yxxpdh, 11) = ""
                    .TextMatrix(Yxxpdh, 12) = ""
                    
                End If
            End If
        End If
        '2.放置行处理程序
        
        '以上为自定义部分]
    End With
    Sjhzyxxpd = True
    Hyxxpdlock = True
    Exit Function
Lrcwcl:      '录入错误处理
    With WglrGrid
        Call Xtxxts(Tsxx, 0, 1)
        
        changelock = True
        .Select Yxxpdh, Lrywlz
        changelock = False
        
        '[>>如果辅助核算出现错误则调用辅助核算功能
        If Bln_AssVali Then
            Call Sub_Drfzhsx(Yxxpdh, Trim(.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls))))
            '解决鼠标点击取消造成的换行
            changelock = True
            .Select Yxxpdh, Lrywlz
            changelock = False
            '<<]
        Else
            Call xswbk
        End If