Test af cprnr ved indtastning

Der er flere måder at gøre det på, men her er min version. Det er muligt du får en fejlmelding p.g.a. koden Chr$(13), hvis du gør det skal du kontrollere dine referencer (eller slette Chr$(13), som giver et linieskift i din MsgBox:

Public Function Check(CPRNR)
Dim Rst As Recordset, Db As Database
Dim VGT As String, i, Sum As Integer, ModSum As Integer, Kontrolciffer As Integer, Svar As String
VGT = 432765432
If Len(CPRNR) <> 10 Then
Svar = Msgbox(Prompt:=\"Der skal indtastes 10 cifre i CPR.\" & Chr$(13) & Chr$(13) & \"Der må ikke indtastes bindestreg.\" & Chr$(13) & Chr$(13) & \"Klik på OK og vend tilbage til CPR-feltet og foretag ny indtastning.\", Title:=\"Indtastningsfejl\", Buttons:=vbOKOnly)
DoCmd.GoToControl \"CPRNR\"
Exit Function
End If
For i = 1 To 9
Sum = Sum + (Val(Mid(CPRNR, i, 1)) * Val(Mid(VGT, i, 1)))
Next
ModSum = Sum Mod 11
If ModSum = 0 Then
Kontrolciffer = 0
Else
Kontrolciffer = 11 - ModSum
End If
If Val(Right(CPRNR, 1)) <> Kontrolciffer Then
Svar = Msgbox(Prompt:=\"Efter indtastning af CPR-nummer har programmet foretaget en gyldighedstest af det indtastede.\" & Chr$(13) & Chr$(13) & \"Testen har afsløret en eller flere fejl i det indtastede CPRNR.\" & Chr$(13) & Chr$(13) & \"Klik på OK vend tilbage til CPR-feltet og foretag en ny indtastning.\" & Chr$(13) & Chr$(13) & \"Du kan ikke gå videre, før programmet har godkendt CPR-NR\", Title:=\"Forkert indtastet CPR-NR\", Buttons:=vbCritical + vbExclamation)
DoCmd.GoToControl \"CPRNR\"
End If
End Function

Jeg bør dog tilføje, at funktionen er indsat i et modul, der modteger variablen CPRNR fra en formular.

Det ses i første linie:

Public Function Check(CPRNR)

hvor (CPRNR) modtages fra formularen. Funktionen skal så kaldes fra formularen med koden:

MODULNAVN.CPRNR

Du skal så erstatte MODULNAVN med det aktuelle navn. Når du laver din punktumnotation vil du få en drop-down liste med de aktuelle nave på procedürerne i modulet.

Private Sub CmdOK_Click()
\'CprNo is a text field

    If (CPR_Ok(Me.CprNo)) Then
        MsgBox \"The CPR number is valid ...\"
    Else
        MsgBox \"The CPR number is invalid ...\"
    End If
End Sub

Function CPR_Ok(ByVal CPR As Variant) As Variant
\' Returns TRUE if CPR is valid

Dim I As Integer
Dim Multipliers(1 To 10) As Integer
Dim Sum As Integer


    If Not IsNull(CPR) Then
        Multipliers(1) = 4
        Multipliers(2) = 3
        Multipliers(3) = 2
        Multipliers(4) = 7
        Multipliers(5) = 6
        Multipliers(6) = 5
        Multipliers(7) = 4
        Multipliers(8) = 3
        Multipliers(9) = 2
        Multipliers(10) = 1
       
        Sum = 0
       
        If Len(CPR) = 10 Then
            For I = 1 To 10
                Sum = Sum + CInt(Mid$(CPR, I, 1)) * Multipliers(I)
            Next I
       
            CPR_Ok = (Sum Mod 11) = 0
           
        End If
    End If
       
   
End Function

Tja - det var jo en anden mulighed

Fint jeg kaster mig ud begge forslag

Held og lykke.

Udover min tidligere kommentar skal du være klar over, at min kode er rettet mod brugere, der ikke er vant til at arbejde med Access. Derfor ser den nok lidt mere indviklet ud end Terry\'s, idet jeg som en forudsætning har valgt, at procedüren skal returnere en MsgBox med oplysning om en evt. fejl, og et forslag til, hvordan fejlen kan rettes. 

amorgos> Hows tings going?

amorgos> Do you still need help on this question?

HELLLLlllooooooo...... Are you there amorgos?

I think he only needs help to close the question -We gave him the solution - He kept the points.

Yes I think your right mugs :o(

Hej Mugs og Terry tak for hjælpen, men når man får en billig rejse til Kreta, må Access komme i anden række.

amorgos > håber du havde en god tur.
Tak for point, kan du få det til at virke?

Hej Mugs og Terry. Jeg må desværre indrømme at jeg ikke kan få Mugs version til at virke, men har brugt Terrys version. Jeg har dog det problem at hvis, Cpr-nummeret ikke er korrekt, kan jeg ikke automatisk vende tilbage til ny indtastning af cprnr.

Så er det den forkerte du har givet pts.
Hvis dit indtastningsfelt hedder: \'txtCpr\'

førOpdateringhændelse:

Private Sub txtCpr_beforeUpdate()
  If not(CPR_Ok(Me.txtCpr)) Then
    msgbox \"fatal ERROR\"
    me.txtCpr = \"\"
    me.txtCpr.setfocus
  end if
end sub

Niels
       

amorgos > jeg har lige kopieret min kode, og sat den ind i en ny db, og det virker. Får du en fejlmeddelelse?

Husk: Koden er beregnet til at sætte ind i et modul. Fra formularen skal du så kalde modulet og procedüren, samt sende variablen CPRNR til modulet sådan:

Modulnavn.Procedürenavn CPRNR

I modulet skal du samtidig angive, at variablen skal modtages:

Public Function (CPRNR)

Hvis du lægger din E-mail, kan jeg sende dig en lille testdb. 

Amorgos > Jeg har fået en mail kl 09:49 der siger, at du har kommenteret svaret.

Jeg kan dog ikke se din kommentar på Eksperten.

Hej Mugs
Jeg vil gerne prøve din version. Jeg må jo ha lavet en bøf et eller andet sted. Så her er min mailadr. amorgos_dk@hotmail.com

Hej Terry!
Jeg har prøvet at anvende den funktion du har beskrevet den 13/9/2001, men får fejlmeddelesen:
Runtime error '2108'
Feltet skal gemmes, før handlingen GåTilKontrolelement, metoden
GoToControl eller metoden SetFocus kan udføres

Jeg kalder Hændelsesproceduren FørOpdatering, og den ser således ud:

'Laver Modul 11 check på det indtastede CPR-nummer, førOpdateringhændelsen
Private Sub CPRnummer_ID_BeforeUpdate(Cancel As Integer)
  If Not (CPR_Ok(Me.CPRnummer)) Then
    MsgBox "CPR-nummer er ikke korrekt"
    Me.CPRnummer = " "
    Me.CPRnummer.SetFocus
  End If

Jeg aner simpelthen ikke hvorledes jeg kom ud af denne situation - nu er jeg jo nybegynder.

Du har placeret koden i feltets BeforeUpdate og fejlmeddelelsen:

Feltet skal gemmes, før handlingen GåTilKontrolelement, metoden
GoToControl eller metoden SetFocus kan udføres

betyder simpelthen, at indtastningen ikke er lagret endnu. Flyt koden til feltets AfterUpdate eller VedUdgang.

Helloooo Mugs!
Jeg skulle have lagt nogle flere points ind - det virker bare super nu. Bortset fra at fokus selvfølgelig skal sættes på CPRnummer_ID
Mange tak for hjælpen.