Foutje in VBA code Acces Office 2019 Pro Plus

H

HMDH

Gebruiker
Lid geworden
11 jun 2010
Berichten
184
Beste forumleden,
Ik ben vreselijk aan het stoeien met een vba code welke ik maar niet goed krijg.
Er zijn 3 cellen waarin een waarde wordt getypt.
Deze hebben alle drie een maxima van
Bak1; 156
Bak2; 152
Bak3; 148
de invoervolgorde is van Bak1 (hier staat de focus) dan enter naar Bak2 en enter naar Bak3.
Als Bak3 in ingevuld (148 max)
Na het invullen van Bak1 zie je gelijk het totaal (Bak1) in het vak; TotaalPunten.
Na invullen van Bak2 zie je gelijk het totaal (Bak1+Bak2) in het vak; TotaalPunten.
Na invullen van Bak3 zie je gelijk het totaal (Bak1+Bak2+Bak3) in het vak; TotaalPunten.
Het probleem is nu dat de invoerwaarde van Bak3 >148 is. zelfs 5555555 kan ik erin typen.
Ik begrijp er niets van.

Misschien is mijn VBA wel te uitgebreid met dubbele functies maar ik heb er helaas geen of nauwelijks verstand van.
Ik hoop dat als ik mijn code stuur dat ik dan een werkende code terug mag krijgen.
Het discussiëren met mij over deze code heeft denkelijk weinig zin.
Natuurlijk kan ik wel aangeven wat de bedoeling is.

#
Code: 
Option Compare Database
Option Explicit
Private lastEnterBak3 As Boolean

' ====== Instelbare maxima per bak ======
Private Const MAX_BAK1 As Integer = 156
Private Const MAX_BAK2 As Integer = 152
Private Const MAX_BAK3 As Integer = 148

' Hulpfunctie: veilige som
Private Function Z(ByVal v) As Long
    Z = Nz(v, 0)
End Function

' ---------------------------
' HULP: record opslaan / weggooien en terug naar frmZoekLid
' ---------------------------
Private Sub SaveAndExit()
    On Error Resume Next

    Dim som As Long
    som = Z(Me!Bak1) + Z(Me!Bak2) + Z(Me!Bak3)

    ' Alles nul? => niks opslaan, record weggooien
    If som = 0 Then
        If Me.Dirty Then Me.Undo
    Else
        ' Er is minstens één score > 0 => record opslaan
        If Me.Dirty Then
            DoCmd.RunCommand acCmdSaveRecord
        End If
    End If

    ' Altijd terug naar frmZoekLid
    DoCmd.Close acForm, Me.Name, acSaveNo
    DoCmd.OpenForm "frmZoekLid", acNormal
End Sub

Private Sub Afbeelding46_Click()
DoCmd.OpenForm "frmStartBlad", acNormal
End Sub

' ===========================
'  FORM LOAD
' ===========================
Private Sub Form_Load()
    On Error Resume Next

    ' 1) LidID ontvangen vanuit frmZoekLid
    If Len(Nz(Me.OpenArgs, "")) > 0 Then
        Me!LidID = CLng(Me.OpenArgs)
    End If

    ' 2) Laatste wedstrijd koppelen
    Dim lngWedstrijdID As Long
    lngWedstrijdID = Nz(DLookup("Max(WedstrijdID)", "tblWedstrijden"), 0)
    If lngWedstrijdID > 0 Then
        Me!WedstrijdID = lngWedstrijdID
    Else
        MsgBox "Er is nog geen wedstrijd geregistreerd in tblWedstrijden!" & vbCrLf & _
               "Maak eerst een record aan in tblWedstrijden.", vbExclamation, "Geen wedstrijd gevonden"
        Exit Sub
    End If

    ' 3) Lidgegevens ophalen uit tblLeden
    Dim crit As String
    crit = "LidID=" & Nz(Me!LidID, 0)

    Me!LidNaam = Nz(DLookup("LidNaam", "tblLeden", crit), "")
    Me!Groep = Nz(DLookup("Groep", "tblLeden", crit), 0)
    Me!LidTag = Nz(DLookup("LidTag", "tblLeden", crit), "")

    ' 4) Startwaarden en focus
    If IsNull(Me!Bak1) Then Me!Bak1 = 0
    If IsNull(Me!Bak2) Then Me!Bak2 = 0
    If IsNull(Me!Bak3) Then Me!Bak3 = 0

    RecalcTotaal
    Me!Bak1.SetFocus

    ' Nodig voor ESC op form-niveau
    Me.KeyPreview = True
    lastEnterBak3 = False

End Sub

' ===========================
'  Totaal opnieuw berekenen
' ===========================
Private Sub RecalcTotaal()
    Me!PuntenTotaal = Z(Me!Bak1) + Z(Me!Bak2) + Z(Me!Bak3)
End Sub

' ===========================
'  Validatie per bak
' ===========================
Private Function ValidateBak(ByVal veldNaam As String, ByVal maxToegestaan As Integer, Cancel As Integer) As Boolean
    Dim v As Variant
    v = Me(veldNaam)

    ' Leeg = 0
    If IsNull(v) Or v = "" Then
        Me(veldNaam) = 0
        ValidateBak = True
        Exit Function
    End If

    ' Alleen cijfers toegestaan
    If Not IsNumeric(v) Or InStr(CStr(v), ".") > 0 Or InStr(CStr(v), ",") > 0 Then
        MsgBox "Alleen hele getallen toegestaan.", vbExclamation, veldNaam
        Cancel = True
        ValidateBak = False
        Exit Function
    End If

    ' Maximaal 3 cijfers
    If Len(CStr(v)) > 3 Then
        MsgBox "Maximaal 3 cijfers toegestaan in " & veldNaam & ".", vbExclamation, veldNaam
        Cancel = True
        ValidateBak = False
        Exit Function
    End If

    ' Niet-negatief
    If CLng(v) < 0 Then
        MsgBox "Negatieve waarden zijn niet toegestaan.", vbExclamation, veldNaam
        Cancel = True
        ValidateBak = False
        Exit Function
    End If

    ' Max per bak
    If CLng(v) > maxToegestaan Then
        MsgBox "Maximale waarde voor " & veldNaam & " is " & maxToegestaan & ".", vbExclamation, veldNaam
        Cancel = True
        ValidateBak = False
        Exit Function
    End If

    ValidateBak = True
End Function

' ===========================
'  BAK 1
' ===========================
Private Sub Bak1_BeforeUpdate(Cancel As Integer)
    Call ValidateBak("Bak1", MAX_BAK1, Cancel)
End Sub

Private Sub Bak1_AfterUpdate()
    RecalcTotaal
End Sub

' ===========================
'  BAK 2
' ===========================
Private Sub Bak2_BeforeUpdate(Cancel As Integer)
    Call ValidateBak("Bak2", MAX_BAK2, Cancel)
End Sub

Private Sub Bak2_AfterUpdate()
    RecalcTotaal
End Sub

' ===========================
'  BAK 3
' ===========================
Private Sub Bak3_BeforeUpdate(Cancel As Integer)
    Call ValidateBak("Bak3", MAX_BAK3, Cancel)
End Sub

Private Sub Bak3_AfterUpdate()
    Dim dummyCancel As Integer

    ' Valideer opnieuw, ook bij Enter
    If Not ValidateBak("Bak3", MAX_BAK3, dummyCancel) Then
        Me.Bak3.Undo        ' Ongeldige invoer herstellen
        Exit Sub
    End If

    Me.Dirty = True
    RecalcTotaal
End Sub

Private Sub Bak3_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        KeyCode = 0

        ' *** Zorg dat de getypte waarde in Bak3 echt wordt opgeslagen ***
        If Me.ActiveControl.Name = "Bak3" Then
            If Me.Bak3.Text <> "" Then
                Me.Bak3 = CLng(Me.Bak3.Text)
            Else
                Me.Bak3 = 0
            End If
        End If

        ' Eerste Enter: alleen totaal tonen
        If Not lastEnterBak3 Then
            lastEnterBak3 = True
            RecalcTotaal
            Exit Sub
        End If

        ' Tweede Enter: opslaan en terug naar frmZoekLid
        lastEnterBak3 = False
        SaveAndExit
    Else
        ' Andere toets dan Enter: reset de “dubbele Enter” logica
        lastEnterBak3 = False
    End If
End Sub



' ===========================
'  FORM_BeforeUpdate
'  (alleen Null ? 0, GEEN Undo meer!)
' ===========================
Private Sub Form_BeforeUpdate(Cancel As Integer)
    ' Zorg dat eventuele lege bakken als 0 worden opgeslagen
    If IsNull(Me!Bak1) Then Me!Bak1 = 0
    If IsNull(Me!Bak2) Then Me!Bak2 = 0
    If IsNull(Me!Bak3) Then Me!Bak3 = 0
End Sub

' ===========================
'  Form_AfterUpdate
'  (leeg gelaten, we sluiten via SaveAndExit)
' ===========================
Private Sub Form_AfterUpdate()
    ' Leeg – afsluiten gebeurt via SaveAndExit (Bak3 Enter)
End Sub

' ===========================
'  ESC ? veilig sluiten
' ===========================
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error Resume Next

    If KeyCode = vbKeyEscape Then
        If Me.Dirty Then Me.Undo
        DoCmd.Close acForm, Me.Name, acSaveNo
        KeyCode = 0
    End If
End Sub

' ===========================
'  Rood kruisje ? ongedaan maken
' ===========================
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    If Me.Dirty Then Me.Undo
    Cancel = False
End Sub

Is er iemand die de moeite wil nemen om mijn code te bekijken en deze aan te passen.
 
Lijkt me handiger als je een (dummy) database aanlevert met het betreffende formulier. Ik zie een hoop (in mijn ogen) overbodige code, dit zou in ieder geval niet mijn aanpak zijn. En ik heb niet de tijd (lees: geen zin) om e.e.a. na te bouwen in een eigen database.
Zelf heb ik dit soort constructies ook wel gemaakt, maar een stuk simpeler, met een procedure bij het wijzigen van elk van de drie invoerbakken. Daarmee check je 'live' of de ingevoerde waarde de drie constanten niet overschrijdt. Daarmee voorkom je dus dat er überhaupt een te grote waarde kan worden ingevoerd. En fouten voorkomen is altijd beter als fouten verbeteren :).
 
Je moet ingelogd zijn om te kunnen reageren. Log in | Registreer
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan