Narzędzia użytkownika

Narzędzia witryny


ms_access

To jest stara wersja strony!


Microsoft Access

Struktura plików aplikacji

  • Plik źródłowy autora tabel aplikacji: source-database.mdb
  • Plik roboczy tabel: database.mde
  • Plik żródłowy autora formularzy: source-forms.mdb
  • Plik roboczy formularzy: forms.mde

Blokada efektu działania Shift przy uruchomieniu aplikacji:

CurrentDb.Properties("AllowBypassKey") = False
  • Narzędzia → Uruchamianie > Wyświetl okno bazy danych: off
  • Narzędzia → Uruchamianie > Użyj specjalnych klawiszy programu access: off
  • Narzędzia → Uruchamianie > Wyświetl formularz/stronę: Wybrać formularz startowy

Przykład 1

  • NumeracjaNazwa tabeli: ludzie
  • WypunktowanieNazwy pól w tabeli: ID, txtImie, txtNazwisko, txtNrEwid
  • WypunktowanieWszystkie pola dodane do formularza. Pole ID jako niewidoczne.

Dodanie skryptu do formularza.

Private Sub Form_BeforeUpdate(Cancel As Integer)
    Dim strImie As String
    Dim strNazwisko As String
    Dim strNrEwid As String
 
    ' Sprawdź puste pola
    If IsNull(Me.txtImie) Or Trim(Me.txtImie & "") = "" Then
        MsgBox "Pole 'Imię' nie może być puste.", vbExclamation, "Wymagane pole"
        Me.txtImie.SetFocus
        Cancel = True
        Exit Sub
    End If
 
    If IsNull(Me.txtNazwisko) Or Trim(Me.txtNazwisko & "") = "" Then
        MsgBox "Pole 'Nazwisko' nie może być puste.", vbExclamation, "Wymagane pole"
        Me.txtNazwisko.SetFocus
        Cancel = True
        Exit Sub
    End If
 
    If IsNull(Me.txtNrEwid) Or Trim(Me.txtNrEwid & "") = "" Then
        MsgBox "Pole 'Nr ewidencyjny' nie może być puste.", vbExclamation, "Wymagane pole"
        Me.txtNrEwid.SetFocus
        Cancel = True
        Exit Sub
    End If
 
    ' Przypisz wartości
    strImie = Me.txtImie & ""
    strNazwisko = Me.txtNazwisko & ""
    strNrEwid = Me.txtNrEwid & ""
 
    ' Sprawdź duplikat pary (Imię+Nazwisko)
    ' Uwaga: używam nazw pól TAKICH JAK W TABELI
    If DCount("*", "ludzie", "[txtImie] = '" & strImie & "' AND [txtNazwisko] = '" & strNazwisko & "' AND [ID] <> " & Nz(Me.ID, 0)) > 0 Then
        MsgBox "Uwaga! Osoba '" & strImie & " " & strNazwisko & "' już istnieje w bazie.", vbExclamation, "Zduplikowany wpis"
        Cancel = True
        Me.txtImie.SetFocus
        Exit Sub
    End If
 
    ' Sprawdź unikalność nrEwid
    If DCount("*", "ludzie", "[txtNrEwid] = '" & strNrEwid & "' AND [ID] <> " & Nz(Me.ID, 0)) > 0 Then
        MsgBox "Uwaga! Numer ewidencyjny '" & strNrEwid & "' już istnieje w bazie.", vbExclamation, "Zduplikowany numer"
        Cancel = True
        Me.txtNrEwid.SetFocus
        Exit Sub
    End If
End Sub

Przykład 2

  • Nazwa tabeli: urzadzenia
  • Pola w tabeli: ID, txtIndeks, txtNazwa, txtTyp, txtRysunek
  • Warunki:
    • txtIndeks nie może się powtarzać
    • txtNazwa może się powtórzyć jeżeli txtTyp lub txtRysunek będzie inny
    • txtTyp lub txtRysunek mogą się powtarzać o ile jedno z nich będzie różne od poprzedniej pary
Private Sub Form_BeforeUpdate(Cancel As Integer)
    Dim strIndeks As String
    Dim strNazwa As String
    Dim strTyp As String
    Dim strRysunek As String
    Dim czysty As String
    Dim i As Integer
 
    ' ========== FORMATOWANIE txtIndeks (zamiast osobnego AfterUpdate) ==========
 
    If Not IsNull(Me.txtIndeks) Then
        ' Usuń wszystko co nie jest cyfrą
        czysty = ""
        For i = 1 To Len(Me.txtIndeks & "")
            If IsNumeric(Mid(Me.txtIndeks, i, 1)) Then
                czysty = czysty & Mid(Me.txtIndeks, i, 1)
            End If
        Next i
 
        ' Nałóż właściwy format
        If Len(czysty) = 12 Then
            Me.txtIndeks = Left(czysty, 4) & " " & Mid(czysty, 5, 3) & " " & Mid(czysty, 8, 3) & " " & Right(czysty, 2)
        ElseIf Len(czysty) > 0 Then
            ' Jeśli nie 12 cyfr, pokaż same cyfry (użytkownik zobaczy błąd za chwilę)
            Me.txtIndeks = czysty
        End If
    End If
 
    ' Pobierz sformatowaną wartość
    strIndeks = Trim(Me.txtIndeks & "")
 
    ' ========== WALIDACJA PUSTYCH PÓL ==========
 
    If IsNull(Me.txtIndeks) Or Trim(Me.txtIndeks & "") = "" Then
        MsgBox "Pole 'Indeks' nie może być puste.", vbExclamation, "Wymagane pole"
        Me.txtIndeks.SetFocus
        Cancel = True
        Exit Sub
    End If
 
    If IsNull(Me.txtNazwa) Or Trim(Me.txtNazwa & "") = "" Then
        MsgBox "Pole 'Nazwa' nie może być puste.", vbExclamation, "Wymagane pole"
        Me.txtNazwa.SetFocus
        Cancel = True
        Exit Sub
    End If
 
    If IsNull(Me.txtTyp) Or Trim(Me.txtTyp & "") = "" Then
        MsgBox "Pole 'Typ' nie może być puste.", vbExclamation, "Wymagane pole"
        Me.txtTyp.SetFocus
        Cancel = True
        Exit Sub
    End If
 
    If IsNull(Me.txtRysunek) Or Trim(Me.txtRysunek & "") = "" Then
        MsgBox "Pole 'Rysunek' nie może być puste.", vbExclamation, "Wymagane pole"
        Me.txtRysunek.SetFocus
        Cancel = True
        Exit Sub
    End If
 
    ' ========== PRZYPISANIE WARTOŚCI ==========
 
    strNazwa = Trim(Me.txtNazwa & "")
    strTyp = Trim(Me.txtTyp & "")
    strRysunek = Trim(Me.txtRysunek & "")
 
    ' ========== WALIDACJA ILOŚCI CYFR ==========
 
    ' Oblicz czysty indeks (bez spacji)
    czysty = Replace(strIndeks, " ", "")
 
    If Len(czysty) <> 12 Then
        MsgBox "Indeks musi zawierać dokładnie 12 cyfr. Format: 0000 000 000 00", vbExclamation, "Nieprawidłowy format"
        Me.txtIndeks.SetFocus
        Cancel = True
        Exit Sub
    End If
 
    ' ========== SPRAWDZENIE UNIKALNOŚCI txtIndeks ==========
 
    If DCount("*", "urzadzenia", "[txtIndeks] = '" & strIndeks & "' AND [ID] <> " & Nz(Me.ID, 0)) > 0 Then
        MsgBox "Uwaga! Indeks '" & strIndeks & "' już istnieje w bazie.", vbExclamation, "Zduplikowany indeks"
        Cancel = True
        Me.txtIndeks.SetFocus
        Exit Sub
    End If
 
    ' ========== SPRAWDZENIE UNIKALNOŚCI PARY (txtTyp + txtRysunek) ==========
 
    If DCount("*", "urzadzenia", "[txtTyp] = '" & strTyp & "' AND [txtRysunek] = '" & strRysunek & "' AND [ID] <> " & Nz(Me.ID, 0)) > 0 Then
        MsgBox "Uwaga! Para Typ '" & strTyp & "' i Rysunek '" & strRysunek & "' już istnieje w bazie.", vbExclamation, "Zduplikowana para"
        Cancel = True
        Me.txtTyp.SetFocus
        Exit Sub
    End If
 
    ' ========== SPRAWDZENIE DLA txtNazwa ==========
 
    If DCount("*", "urzadzenia", "[txtNazwa] = '" & strNazwa & "' AND [txtTyp] = '" & strTyp & "' AND [txtRysunek] = '" & strRysunek & "' AND [ID] <> " & Nz(Me.ID, 0)) > 0 Then
        MsgBox "Uwaga! Urządzenie o nazwie '" & strNazwa & "' z Typem '" & strTyp & "' i Rysunkiem '" & strRysunek & "' już istnieje.", vbExclamation, "Zduplikowany wpis"
        Cancel = True
        Me.txtNazwa.SetFocus
        Exit Sub
    End If
 
    ' Wszystko OK – rekord zostanie zapisany
End Sub    
ms_access.1780685066.txt.gz · ostatnio zmienione: przez sindap

Donate Powered by PHP Valid HTML5 Valid CSS Driven by DokuWiki