刪除記錄表格並更新字段號碼

Question

在我正在使用的表單中有一個步驟列表，其中包含步驟編號。用戶可以使用兩個按鈕移動步驟。如果想要移動一個步驟，他們點擊記錄選擇器，然後按下一個按鈕。如果他們按下了向下按鈕，它將向下移動該按鈕，並將該數字更改爲它應該是的數字，對於向上移動列表的記錄也是如此。但是，有時候我們需要刪除一個步驟。問題在於它不會重新編號字段，需要手動完成。

我已經嘗試修改向下按鈕代碼，它會將記錄向下移動一個，但我遇到了原始問題。實質上，我需要它移動到列表的底部，並在此過程中重新編號。我已經嘗試使用帶有Do和循環命令的代碼，但它只會編號步數，但不會移動該步和添加，它只會增加計數。例如，如果我將第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

我已經使用了類似的代碼，雖然簡單得多，因爲它只是循環記錄集。

有問題的字段被稱爲優先它被直接編輯到所需的值;那麼所有其他記錄在更新後立即重新編號。如果需要，您應該能夠修改：

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