老师，

    如何实现，已使用的不是末级的部门编码不允许增加下级，除非删除已使用的职员档案资料，才可以修改。

举例：

   部门档案 01财务      职员档案 0001 某某 属于01财务

现在增加了部门0101 财务下的结算部    在职员档案中找到 了已经使用的 01 财务 不允许增加。例子如下：

下载信息  [文件大小：   下载次数： ]

点击浏览该文件:部门档案.foxdb

有点甜老师，

     还是不行，没达到目标，好似没有变化。

关键是不明白你的需求是什么，数据表改变了，生成的树一定会改变的，2楼的例子只是限制录入子部门。

你给的需求不合理。

DatacolChanging代码替换一下

If e.DataCol.Name = "编码规则" Then
    Dim dr As DataRow
    dr = e.DataTable.Find("编码规则 = \'" & e.NewValue & "\'")
    If dr IsNot Nothing Then
        MessageBox.Show("编码重复!")
        e.Cancel = True
        dr.Delete
    End If
End If

If e.DataCol.Name = "编码规则" AndAlso e.NewValue <> Nothing Then
    Dim fdr As DataRow = DataTables("分类编码方案").Find("基础档案名称 = \'" & e.DataTable.Name & "\'")
    If fdr IsNot Nothing Then
        Dim reg As new System.Text.RegularExpressions.Regex(fdr("正则"))
        If reg.Ismatch(e.NewValue) = False Then
            e.Cancel = True
        Else
            e.DataRow("是否末级") = (fdr("字符数") = e.NewValue.length)\'我加的
            Dim count As Integer = 0
            Dim prev As String = ""
            For i As Integer = 0 To fdr("编码规则").length - 1
                count += val(fdr("编码规则").chars(i))
               
                Dim str As String = e.NewValue.Substring(0, count)
               
                If DataTables("职员档案").Find("编码规则 = \'" & str & "\'") IsNot Nothing Then
                    msgbox("已使用,不能添加")
                    e.NewValue = Nothing
                    Exit For
                Else
                   
                   
                    If count < e.NewValue.length Then
                        If e.DataTable.Find("编码规则 = \'" & str & "\'") Is Nothing Then
                            MessageBox.Show("缺少上级科目:" & str,"提示",MessageBoxButtons.OK)
                            e.Cancel = True
                            e.DataRow("是否末级")=False
                            Exit For
                        End If
                    Else If count = e.NewValue.length  Then
                        If i = fdr("编码规则").length - 1 Then
                            e.DataRow("是否末级") = True
                            e.DataTable.ReplaceFor("是否末级", False, "编码规则 = \'" & prev & "\'")
                        Else
                            Dim filter As String = "编码规则 <> \'" & str & "\' and 编码规则 like \'" & str & "*\'"
                            If  e.DataTable.Find(filter) Is Nothing Then
                                e.DataRow("是否末级") = True
                                filter = "编码规则 = \'" & prev & "\'"
                                e.DataTable.ReplaceFor("是否末级", False, filter)
                            Else
                                e.DataRow("是否末级") = False
                            End If
                           
                            Exit For
                        End If
                    End If
                    prev = str
                End If
            Next
           
        End If
    End If
End If

 datacolchanging事件，代码

If e.DataCol.Name = "编码名称" Then
    Dim dr As DataRow
    dr = e.DataTable.Find("编码名称 = \'" & e.NewValue & "\'")
    If dr IsNot Nothing Then
        MessageBox.Show("部门名称重复是否正确!","请确认")
        e.Cancel = True
    Else
        dr = DataTables("职员档案").Find("编码名称 = \'" & e.OldValue & "\'")
        If dr IsNot Nothing Then
            msgbox("已使用,不能重命名")
        End If
    End If
End If

If e.DataCol.Name = "编码规则" Then
    Dim dr As DataRow
    dr = e.DataTable.Find("编码规则 = \'" & e.NewValue & "\'")
    If dr IsNot Nothing Then
        MessageBox.Show("编码重复!")
        e.Cancel = True
        dr.Delete
    End If
End If

If e.DataCol.Name = "编码规则" AndAlso e.NewValue <> Nothing Then
    Dim fdr As DataRow = DataTables("分类编码方案").Find("基础档案名称 = \'" & e.DataTable.Name & "\'")
    If fdr IsNot Nothing Then
        Dim reg As new System.Text.RegularExpressions.Regex(fdr("正则"))
        If reg.Ismatch(e.NewValue) = False Then
            e.Cancel = True
        Else
            e.DataRow("是否末级") = (fdr("字符数") = e.NewValue.length)\'我加的
            Dim count As Integer = 0
            Dim prev As String = ""
            For i As Integer = 0 To fdr("编码规则").length - 1
                count += val(fdr("编码规则").chars(i))
               
                Dim str As String = e.NewValue.Substring(0, count)
                If count < e.NewValue.length Then
                    If e.DataTable.Find("编码规则 = \'" & str & "\'") Is Nothing Then
                        MessageBox.Show("缺少上级科目:" & str,"提示",MessageBoxButtons.OK)
                        e.Cancel = True
                        e.DataRow("是否末级")=False
                        Exit For
                    Else If e.OldValue = str Then
                        MessageBox.Show("缺少上级科目:" & str,"提示",MessageBoxButtons.OK)
                        e.Cancel = True
                        Exit For
                    End If
                Else If count = e.NewValue.length  Then
                    If i = fdr("编码规则").length - 1 Then
                        e.DataRow("是否末级") = True
                        e.DataTable.ReplaceFor("是否末级", False, "编码规则 = \'" & prev & "\'")
                    Else
                        Dim filter As String = "编码规则 <> \'" & str & "\' and 编码规则 like \'" & str & "*\'"
                        If  e.DataTable.Find(filter) Is Nothing Then
                            e.DataRow("是否末级") = True
                            filter = "编码规则 = \'" & prev & "\'"
                            e.DataTable.ReplaceFor("是否末级", False, filter)
                        Else
                            e.DataRow("是否末级") = False
                        End If
                       
                        Exit For
                    End If
                End If
                prev = str
            Next
        End If
    End If
End If