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.
#
Is er iemand die de moeite wil nemen om mijn code te bekijken en deze aan te passen.
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.