VB开发的ERP系统

            .Buttons("zh").Enabled = True       '增行
            .Buttons("sh").Enabled = True       '删行
            .Buttons("bc").Enabled = True       '保存
            .Buttons("fq").Enabled = True       '放弃
        End Select
    End With
End Sub

Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
    Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
    
    '如果单据操作状态为浏览状态则不能显示录入载体
    If Trim(Lab_OperStatus.Caption) = "1" Then Exit Sub
    
    '显示文本框前返回有效行列（解决滚动条问题）
    Call Xldqh
    Call Xldql
    
    '隐藏文本框,帮助按钮,列表组合框
    Call Ycwbk
    
    With WglrGrid
        Dqlrwgh = .Row
        Dqlrwgl = .col
        If Not GridBoolean(.col, 1) Or .Row < .FixedRows Then Exit Sub
        Wbkpy = 30
        Wbkpy1 = 15
        If GridBoolean(.col, 3) Then        '若是下拉列表录入
            YdCombo.Left = .CellLeft + .Left + Wbkpy
            YdCombo.Top = .CellTop + .Top + Wbkpy
            YdCombo.Width = .CellWidth - Wbkpy1
            Call Wbkcl                          '主要是在下拉列表框可用之前填充下拉列表框
            YdCombo.Visible = True
            YdCombo.SetFocus
            Ydcommand.Visible = False
            Ydtext.Visible = False
            Yd_Help.Visible = False
        Else
            If GridBoolean(.col, 2) Then        '是否提供帮助
                Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
                Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
                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
            If Ydtext.Enabled Then 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
    Case "006"         '来源科目
        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 .Fields("StopFlag") Then
                        Tsxx = "此科目已停用"
                        GoTo Lrcwcl
                    End If
                End If
                '如果此科目存在且改变过则执行下列操作
                '1.显示科目编码,改变科目名称
                WglrGrid.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls)) = Trim(RecTemp.Fields("Ccode"))
                WglrGrid.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = Trim(RecTemp.Fields("Cname"))
            End With
        Else
            '清除所有内容
            If GridStr(Dqpdwgl, 1) = "006" Then
                WglrGrid.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = ""
            End If
        End If
    Case "004"     '转帐方向
        If Len(Str_JudgeText) <> 0 Then
            If Str_JudgeText <> "借" And Str_JudgeText <> "贷" Then
                Tsxx = "转帐方向必须选择“借”或“贷”"
                GoTo Lrcwcl
            End If
        End If
    Case "008"     '来源数据项
        If Len(Str_JudgeText) <> 0 Then
            SqlStr = "Select * from Cwzz_Formula where  Formulacode='" & Str_JudgeText & "' OR FormulaName='" & Str_JudgeText & "'"
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
            With RecTemp
                If .EOF Then
                    Tsxx = "此取数项目不存在!"
                    GoTo Lrcwcl
                End If
            End With
            '2.放置字段事后处理程序
            WglrGrid.TextMatrix(Dqpdwgh, 13) = RecTemp.Fields("FormulaCode")
            '以上为自定义部分]
        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