删除表格外的记录并更新字段编号

Question

在我使用的表格中有一个步骤列表，其中包含步骤编号。用户可以使用两个按钮移动步骤。如果想移动一步，他们单击记录 select 或然后按一个按钮。如果他们按下向下按钮，它将向下移动一个并将数字更改为它应该是的数字，这同样适用于在列表中向上移动的记录。但是，有时我们需要删除一个步骤。这样做的问题是它不会对字段重新编号，需要手动完成。

我试过修改向下按钮的代码，它会将记录向下移动一位，但我运行进入了原始问题。本质上，我需要它移动到列表的底部并在这样做的同时重新编号其余部分。我已经尝试将代码与 Do 和循环命令一起使用，但它只会对步骤编号进行编号，但不会移动步骤和添加，它只会增加计数。例如，如果我将第 3 步移出第 7 步，它将显示为 1、2、4、5、6、7、8。每次我按下按钮时，这都会继续。如果我 select 一条记录并反复按下向下按钮，它将毫无问题地向下移动记录。

这是按下按钮的代码。

On Error GoTo ErrHandler
    If Me.frm_Steps_Listing.Form.CurrentRecord = Me.frm_Steps_Listing.Form.RecordsetClone.RecordCount Then
        MsgBox "This record cannot move down anu more!"
        Exit Sub
    End If
    Call MoveCurrentRecord(Me.frm_Steps_Listing.Form, 1, "tbl_Steps", "Step_ID", "Step")
Exit_cmdMoveUp:
    Exit Sub
ErrHandler:
    MsgBox Error$
    Resume Exit_cmdMoveUp

Public Sub MoveCurrentRecord(Current_Form As Form, intMove As Integer, Current_Table As String, Primary_Key As String, Sequence_Field As String)
    Dim booSomethingMoved As Boolean
    Dim lngCurrentPosition As Long
    Dim lngNewPosition As Long
    Dim rstComponents As Recordset
    Dim rstTable As Recordset
    Dim lngCurrentRecordID As Long
    Set rstComponents = Current_Form.RecordsetClone
    Set rstTable = CurrentDb.OpenRecordset(Current_Table, dbOpenDynaset)
    booSomethingMoved = False
    'If there are no records then exit
    If rstComponents.RecordCount <> 0 Then
        With rstComponents
            'Set the current record of the clone to the currently selected record
            .Bookmark = Current_Form.Bookmark
            lngCurrentRecordID = .Fields(Primary_Key)
            lngCurrentPosition = .Fields(Sequence_Field)
            If intMove = 1 Then
                .MovePrevious
                If Not .BOF Then
                    lngNewPosition = .Fields(Sequence_Field)
                    rstTable.FindFirst "[" & Primary_Key & "] = " & lngCurrentRecordID
                    rstTable.Edit
                    rstTable.Fields(Sequence_Field) = lngNewPosition
                    rstTable.Update
                    rstTable.FindFirst "[" & Primary_Key & "] = " & .Fields(Primary_Key)
                    rstTable.Edit
                    rstTable.Fields(Sequence_Field) = lngCurrentPosition
                    rstTable.Update
                    booSomethingMoved = True
                End If
            End If

对于删除按钮，代码是相同的，但我用它来输入。

Call MoveCurrentRecord(Me.frm_Steps_Listing.Form, 1, "tbl_Steps", "Step_ID", "Step")

Public sub 的初始部分是相同的，除了当我到达我正在呼叫的部分时。

If intMove = 2 Then

                   Do While Not .EOF
                    .MoveNext



                    lngNewPosition = .Fields(Sequence_Field)
                    rstTable.FindFirst "[" & Primary_Key & "] = " & lngCurrentRecordID
                    rstTable.Edit
                    rstTable.Fields(Sequence_Field) = lngNewPosition
                    rstTable.Update

                    rstTable.FindFirst "[" & Primary_Key & "] = " & .Fields(Primary_Key)
                    rstTable.Edit
                    rstTable.Fields(Sequence_Field) = lngCurrentPosition + 1
                    rstTable.Update
                    booSomethingMoved = True
                    .MoveNext


                 Exit Do
                Loop

            End If

我真的不确定为什么 Do 命令不起作用，但它会作为 If 命令起作用。我感谢对此的任何反馈。

在查看了提出的建议后，我想出了解决方案。

If intMove = 2 Then
                    Dim i As Integer
                    i = 0
                   Do Until .EOF
                    .MoveNext
                   If Not .EOF Then

                    lngNewPosition = .Fields(Sequence_Field)
                    rstTable.FindFirst "[" & Primary_Key & "] = " & lngCurrentRecordID
                    rstTable.Edit
                    rstTable.Fields(Sequence_Field) = lngNewPosition
                    rstTable.Update

                    rstTable.FindFirst "[" & Primary_Key & "] = " & .Fields(Primary_Key)
                    rstTable.Edit
                    rstTable.Fields(Sequence_Field) = lngCurrentPosition + i
                    rstTable.Update
                    booSomethingMoved = True

                    i = i + 1
                  End If
               ' Exit Do
           Loop
            End If


            'End If

Answer 1

我使用过类似的代码，但简单得多，因为它只是循环记录集。

有问题的字段被称为 Priority，它被直接编辑为所需的值；然后所有其他记录在更新后立即重新编号。您应该可以根据需要进行修改：

Private Sub Priority_AfterUpdate()

    Dim rst             As DAO.Recordset
    Dim lngId           As Long
    Dim lngPriorityNew  As Long
    Dim lngPriorityFix  As Long

    ' Save record.
    Me.Dirty = False

    ' Prepare form.
    DoCmd.Hourglass True
    Me.Repaint
    Me.Painting = False

    ' Current Id and priority.
    lngId = Me!Id.Value
    lngPriorityFix = Nz(Me!Priority.Value, 0)
    If lngPriorityFix <= 0 Then
        lngPriorityFix = 1
        Me!Priority.Value = lngPriorityFix
        Me.Dirty = False
    End If

    ' Rebuild priority list.
    Set rst = Me.RecordsetClone
    rst.MoveFirst
    While rst.EOF = False
        If rst!Id.Value <> lngId Then
            lngPriorityNew = lngPriorityNew + 1
            If lngPriorityNew = lngPriorityFix Then
                ' Move this record to next lower priority.
                lngPriorityNew = lngPriorityNew + 1
            End If
            If Nz(rst!Priority.Value, 0) = lngPriorityNew Then
                ' Priority hasn't changed for this record.
            Else
                ' Assign new priority.
                rst.Edit
                    rst!Priority.Value = lngPriorityNew
                rst.Update
            End If
        End If
        rst.MoveNext
    Wend

    ' Reorder form and relocate record.
    Me.Requery
    Set rst = Me.RecordsetClone
    rst.FindFirst "Id = " & lngId & ""
    Me.Bookmark = rst.Bookmark

    ' Present form.
    Me.Painting = True
    DoCmd.Hourglass False

    Set rst = Nothing

End Sub

删除表格外的记录并更新字段编号

Delete record out of form and update the field numbers

ms-access

vba

ms-access-2010

ms-access-2013