Question

在我正在使用的表格中，它有一个步骤列表，其中包含步骤编号。用户可以使用两个按钮移动步骤。如果要移动步骤，则单击记录选择器，然后按一个按钮。如果他们按下向下按钮，它将向下移动一步并将数字更改为它应该是什么，并且对于向上移动列表的记录也是如此。但是，有时我们需要删除一个步骤。这个问题是它没有重新编号字段，需要手动完成。

我已尝试修改向下按钮代码，它会将记录向下移动一个，但我遇到了原始问题。从本质上讲，我需要它移动到列表的底部并重新编号其余部分。我已尝试使用带有Do和loop命令的代码，但它只会对步骤编号进行编号，但不会移动步骤和添加，它只会增加计数。例如，如果我将步骤3移出7，它将读取1,2,4,5,6,7,8。每按一次按钮，这将继续。如果我选择一个记录并反复按下向下按钮，它将向下移动记录没有问题。

这是按钮按下的代码。

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

从表单中删除记录并更新字段编号

1 个答案: