Autonumeracja rekordów w Accessie przy przeliczaniu numerów porządkowych

Autonumeracja rekordów w Accessie przy przeliczaniu numerów porządkowych
K1
  • Rejestracja: dni
  • Ostatnio: dni
  • Postów: 5
1

Potrzebowałem aby Access sam przeliczał mi ilość rekordów w tabeli/formularzu, z racji tego, że dość często występowała potrzeba kasowania nadmiarowych rekordów napisałem taki krótki kod aby Access sam za mnie:

Kopiuj
Private Sub Form_Open(Cancel As Integer)
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
    Dim X As Long
    Dim db As Database
Set db = CurrentDb
    Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("Rejestr Kwerend")
rs.MoveFirst
X = 1
While Not rs.EOF
rs.Edit
rs.Fields("lp") = X
rs.Update
rs.MoveNext
X = X + 1
Wend

Do pewnego momentu wszystko działa jak należy, ale po jakimś czasie pojawia się problem, że powyższa autonumeracja płata figle i zamiast dodawać kolejną liczbę np. jest wpisanych 50 rekordów dodaje nowy i zamiast 51 pozycji wyskakuje, że teraz będzie ponownie przeliczał od 26, nie kasuje wpisu nr 26 ale przesuwa go na pozycję 27. Takie wepchanie się w kolejkę. Nie bardzo wiem jak to porpawić

TR
  • Rejestracja: dni
  • Ostatnio: dni
  • Postów: 119
1

Wstaw przed rs.MoveFirst rs.MoveLast i sprawdz.

Kod wyglądałby tak:

Kopiuj
 [Private Sub Form_Open(Cancel As Integer)
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
    Dim X As Long
    Dim db As Database
Set db = CurrentDb
    Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("Rejestr Kwerend")
rs.MoveLast
rs.MoveFirst
X = 1
While Not rs.EOF
rs.Edit
rs.Fields("lp") = X
rs.Update
rs.MoveNext
X = X + 1
Wend](http://)
K1
  • Rejestracja: dni
  • Ostatnio: dni
  • Postów: 5
0

Niestety nie działa wstawienie MoveLast. Próbowałem też zmienić ustawienia pola z liczby na tekst itd., i też nie działa. Wstawiałem też kilka nowych rekordów i po wstawieniu około 20 znów zaczęło wstawiać od losowej liczby

TR
  • Rejestracja: dni
  • Ostatnio: dni
  • Postów: 119
0

Rozumiem. Próbowałem odtworzyć błąd ale u mnie na 1 048 575 rekordów działa czego bym nie zrobił

Nie mam Twojego formularza, może tam jest przyczyna? Tak więc proponuję spróbować bez niego, zapisać niezależną procedurą gdzieś w module.
ten kod u mnie dział bez zastrzeżeń:

Kopiuj
Sub numeruj()

'DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

    Dim X As Long
    Dim db As Database
Set db = CurrentDb
    Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("Rejestr Kwerend")
rs.MoveFirst
X = 1
While Not rs.EOF
rs.Edit
rs.Fields("lp") = X
rs.Update
rs.MoveNext
X = X + 1
Wend

End Sub
VBService
  • Rejestracja: dni
  • Ostatnio: dni
1

Może spróbuj zapisać tak:

Kopiuj
Sub Numeruj()
    On Error GoTo ErrHandler
    
    Dim X As Long
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Rejestr Kwerend")
    
    If Not rs.EOF Then
        rs.MoveFirst
        X = 1
        While Not rs.EOF
            rs.Edit
            rs.Fields("lp") = X
            rs.Update
            rs.MoveNext
            X = X + 1
        Wend
    End If
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Sub

ErrHandler:
    MsgBox "Wystąpił błąd: " & Err.Description, vbExclamation
    If Not rs Is Nothing Then rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

może pozwoli to na "wyłapanie" błędu, który powoduje to dziwne działanie.

K1
  • Rejestracja: dni
  • Ostatnio: dni
  • Postów: 5
1

Powyższy kod zastosowałem w procedurze wejścia do przeliczenia wartości pola "lp". W samym formularzu jest też możliwość wstawienia nowego rekordu z tym samym kodem, poprzez przycisk dodaj rekord. W obu przypadkach, stosowanych naprzemiennie, przeliczanie działa do pewnego momentu, około 30 powtórzeń, a następnie następuje wstawianie liczby w losowym miejscu, po zastosowaniu Error handler problem pojawia się po dodaniu 90 rekordów, Access zaczyna numerwać nowe rekordy od 1.
W tym formularzu nie ma więcej żadnego kodu, zastosowałem jedynie makra do nawigowania.
Spróbuję, tak jak radził TytusRomek, stworzyć nową bazę danych i zastosuję powyższy kod i zobaczę czy dalej Access będzie wariował z przeliczaniem i napiszę czy problem został w ten sposób rozwiązany.
Póki co dziękuje za pomoc.

K1
  • Rejestracja: dni
  • Ostatnio: dni
  • Postów: 5
0

Problem rozwiązałem zmieniając linijkę

Kopiuj
Set rs = db.OpenRecordset("Rejestr Kwerend")

na tak wyglądającą

Kopiuj
Set rs = db.OpenRecordset("Rejestr Kwerend", dbOpenDynaset)

cały kod wygląda teraz tak

Kopiuj
Private Sub Form_Open(Cancel As Integer)
    On Error GoTo ErrHandler
    
    Dim X As Long
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    

    Set db = CurrentDb
    Set rs = db.OpenRecordset("Rejestr Kwerend", dbOpenDynaset)
    
    If Not rs.EOF Then
        rs.MoveFirst ' Ustawiamy kursor na pierwszym rekordzie
        X = 1 ' Rozpoczynamy numerowanie od 1
        
        While Not rs.EOF
            rs.Edit
            rs.Fields("lp") = X
            rs.Update
            rs.MoveNext
            X = X + 1
        Wend
    End If
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Sub

ErrHandler:
    MsgBox "Wystąpił błąd: " & Err.Description, vbExclamation
    If Not rs Is Nothing Then
        rs.Close
    End If
    Set rs = Nothing
    Set db = Nothing
End Sub

i póki co działa jak należy, dlaczego bez "dbOpenDynaset" nie działało nie mam pojęcia.
Dziękuje jeszcze raz za poświęcony czas.

TR
  • Rejestracja: dni
  • Ostatnio: dni
  • Postów: 119
0

i póki co działa jak należy, dlaczego bez "dbOpenDynaset" nie działało nie mam pojęcia.
Dziękuje jeszcze raz za poświęcony czas.

A ten "rejestr kwerend" to nie jest przypadkiem arkusz z tabelą (zamiast zwykłego zakresu) albo jakaś połączona tabela, jakiś link do innych danych?
chyba nie zauważyłem że pytasz o accessa;)
ten "rejestr kwerend" to jest jakaś prosta kwerenda?

K1
  • Rejestracja: dni
  • Ostatnio: dni
  • Postów: 5
0

"rejestr kwerend" to jest tabela na podstawie której stworzyłem formularz, jednakże stworzyłem w nowym pliku podobnie tabelę i na jej podstawie formularz i w tym przypadku kod działał prawidłowo bez "dbOpenDynaset". I szczerze mówiąc nie mam siły się nawet zastanawiać dlaczego akurat w tym konkretnym przypadku dopiero ta zmiana spowodowała poprawne działanie. Jeśli jest głupie ale działa to lepiej niech działa

Zarejestruj się i dołącz do największej społeczności programistów w Polsce.

Otrzymaj wsparcie, dziel się wiedzą i rozwijaj swoje umiejętności z najlepszymi.