Een beetje hulp nodig bij VBA scripting in MS Access 2016

Windows, Android, iOS, Linux, Chrome OS, ...
Plaats reactie
Gebruikersavatar
Mortov Molotov
Pro Member
Pro Member
Berichten: 341
Lid geworden op: 07 jan 2012, 10:57
Uitgedeelde bedankjes: 88 keer
Bedankt: 34 keer
Recent bedankt: 4 keer

Dag iedereen,

in het dagelijkse leven ben ik arts, en reik ik dus ook die langwerpige getuigschriftjes voor verstrekte hulp uit.

Een beetje achtergrondinformatie m.b.t. mijn vragen hierbij is de volgende (cfr ook de link hierboven voor een pic).

Als arts moet je de volgende informatie altijd duidelijk opschrijven:
- de naam vd patiënt
- datum vd consultatie
- de zescijferige code(s) m.b.t. terugbetaling; dit is van belang voor de mutualiteit, omdat die dan weten hoeveel ze de patiënt moeten terugbetalen; bv. consultatie bij een huisarts: 101076, ca. 20 euro terugbetaald, afhankelijk van je statuut; bv. bij een reumatoloog: 102653, 44 euro terugbetaald, 53 euro indien je een WIGW statuut hebt.
- het bedrag: tegenwoordig moet dit er - m.i. terecht - duidelijk opstaan, FYI


Wij artsen hebben dergelijke getuigschriften verzameld in "boekjes" van telkens 50 van die getuigschriften. Telkens zo'n boekje vol is, moet je het samengeteld bedrag en de datum van het laatste getuigschrift erop zetten.


Voor het bijhouden van mijn "boekjes" heb ik een access database geschreven die operationeel is, mits je op de hoogte bent van de bugs in het systeem.
Ik kan dus alle data ingeven, en een rapport is beschikbaar om o.a. het samengeteld bedrag te berekenen.

Er zijn dus wel nog enkele bugs in 't systeem
1. in het formulier waar ik mijn data ingeef, heb ik via een combinatie van VBA code en field defaults al geregeld dat:
- bij het openen van een nieuw record (getuigschrift), de nummering automatisch +1 stijgt
- de datum en het "boekje", waarvan van het vorige getuigschrift (record) deel uitmaakte, automatisch worden overgenomen in het nieuwe record
- dit is logisch, gezien je 50 getuigschriften na elkaar van 't zelfde boekje invult, en bovendien hoef je de datum dus niet telkens opnieuw in te geven, hooguit enkele malen wat te wijzigen tijdens het ingeven van je gegevens (het is nl zo dat één boekje (van 50 getuigschriften) na twee, hooguit drie dagen volledig is opgebruikt; dit afhankelijk van het aantal patiënten je in die periode ziet

2. maar anderzijds had ik graag gewild dat na invullen van het vijftigste boekje
- hetzij alles gereset wordt voor het eerstvolgende record; alle velden leeg dus, want je begint aan een nieuw boekje
- hetzij er géén nieuwe record wordt aangemaakt, en meteen het rapport voor dat boekje wordt geopend; ergens logisch, gezien je dan moet beginnen samentellen
- en sowieso had ik op het formulier een knop gezet die het rapport voor het huidige boekje opent.

3. Ik slaag er maar niet in om een default value automatisch te laten selecteren voor het Codes field (= lookup list); bij voorkeur zou dat 102653 moeten zijn.


Hieronder volgen enkele gegevens m.b.t. de structuur van de database:
(mocht dit niet voldoende zijn, laat het me weten, dan kan ik eea hier aanvullen)

1. Design van Receipts tabel:
https://prnt.sc/hyeiex

2. DB Relationship
https://prnt.sc/hyeimo

3. Formulier om data in te geven
https://prnt.sc/hyej0z

4. SQL code van de query waarvan het rapport "AllReceipts" gebruik maakt:

Code: Selecteer alles

SELECT Books.Book, Receipts.Nr, Receipts.CDate, Receipts.Codes, Receipts.Amount, Receipts.PaymentMethod, Receipts.RDate, Receipts.Comments
FROM Books INNER JOIN Receipts ON Books.ID = Receipts.Book
ORDER BY Books.Book, Receipts.Nr;
5. De VBA code voor hetgeen ik in puntje 1. hierboven heb beschreven

Code: Selecteer alles

Option Compare Database
Option Explicit

Private Sub Form_Current()
   Dim RS As DAO.Recordset
      
   On Error Resume Next
   
   ' Exit if not on the new record.
   If Not NewRecord Then Exit Sub
   
   ' Goto the last record of the form recordset (to autofill form).
   Set RS = RecordsetClone
   RS.MoveLast
      
   ' Exit if you cannot move to the last record (no records).
   If Err <> 0 Then Exit Sub
   
   Painting = False
   
   If NrTxt <= 50 Then
    BookCombo = RS(BookCombo.ControlSource)
    CDateTxt = RS(CDateTxt.ControlSource)
    NrTxt = RS(NrTxt.ControlSource) + 1
   Else
    BookCombo = ""
    CDateTxt = ""
   End If

   Painting = True

End Sub
tb0ne
Elite Poster
Elite Poster
Berichten: 1020
Lid geworden op: 24 aug 2012, 11:49
Uitgedeelde bedankjes: 27 keer
Bedankt: 85 keer

Kan je die nummering niet door access laten afhandelen met een auto increment?
Telkens je nummer deelbaar is door 50 ben je rond en het resultaat is het aantal volle boekjes tot nu toe, daarmee kan je dan bepalen wat er in je formulier gebeurt?
Gebruikersavatar
Mortov Molotov
Pro Member
Pro Member
Berichten: 341
Lid geworden op: 07 jan 2012, 10:57
Uitgedeelde bedankjes: 88 keer
Bedankt: 34 keer
Recent bedankt: 4 keer

Thx

Is een andere benadering van dezelfde if then else clause, maar ik heb de indruk dat alles wat bij else staat, momenteel niet wordt uitgevoerd. Zo heb ik eens een poging gedaan met een simpele msgbox, werd niet getoond, evenmin error.

Maar ik probeer jouw voorstel zo meteen eens.

Mvg

AANVULLING: enig idee hoe je dat zou omzetten in VBA code?
Gebruikersavatar
cptKangaroo
Elite Poster
Elite Poster
Berichten: 3057
Lid geworden op: 18 dec 2004, 14:33
Locatie: 053 Aalst
Uitgedeelde bedankjes: 666 keer
Bedankt: 227 keer
Recent bedankt: 2 keer

Voor VBA kan je de Mod operator gebruiken, bijvoorbeeld: if (UwAantal Mod 50) = 0 then is het deelbaar door 50
Oftewel: If UwAantal/50 = UwAantal\50 then is het deelbaar door 50

Schrap de "On Error Resume Next" lijn eens om te zien of er geen fout optreedt waardoor de Else niet bereikt wordt.
Gebruikersavatar
Mortov Molotov
Pro Member
Pro Member
Berichten: 341
Lid geworden op: 07 jan 2012, 10:57
Uitgedeelde bedankjes: 88 keer
Bedankt: 34 keer
Recent bedankt: 4 keer

Heb eea aangepast, en er is toch wat duidelijk geworden

Heb die on error resume next verwijderd en ik kwam er meteen achter dat de validatieregel in het design van de Receipts tabel voor het Nr field, nl >0 en <51, dwars lag (alle getuigschrifen zijn genummerd van 1 tot 50). Heb deze regel verwijderd en dan de if then else clause aangepast volgens de de code hieronder.

Code: Selecteer alles

Option Compare Database
Option Explicit

Private Sub Form_Current()
   Dim RS As DAO.Recordset
      
   ' Exit if not on the new record.
   If Not NewRecord Then Exit Sub
   
   ' Goto the last record of the form recordset (to autofill form).
   Set RS = RecordsetClone
   RS.MoveLast
      
   ' Exit if you cannot move to the last record (no records).
   If Err <> 0 Then Exit Sub
   
   Painting = False
   
   If (NrTxt Mod 50) <> 0 Then
    BookCombo = RS(BookCombo.ControlSource)
    CDateTxt = RS(CDateTxt.ControlSource)
    NrTxt = RS(NrTxt.ControlSource) + 1
   Else
    NrTxt = 1
   End If

   Painting = True

End Sub

Echter, nu kiest de software nog altijd de else clause niet igv van NrTxt = 50; wat vreemd is, want dan zou het resultaat 0 moeten zijn (else dus), en zou hij NrTxt = 1 moeten zetten; nu verschijnt er gewoon 51...
Gebruikersavatar
cptKangaroo
Elite Poster
Elite Poster
Berichten: 3057
Lid geworden op: 18 dec 2004, 14:33
Locatie: 053 Aalst
Uitgedeelde bedankjes: 666 keer
Bedankt: 227 keer
Recent bedankt: 2 keer

Als je zeker bent dat ie niet één van die 'exit sub' statements gebruikt in die situatie, dan vermoed ik dat er nog ergens een auto-increment aanstaat die er nog eentje bijlapt bij NrTxt zonder daarbij door je If statement te gaan, omdat je die NrTxt waarde blijkbaar ophaalt vanuit de recordset:

NrTxt = RS(NrTxt.ControlSource) + 1

Een ander gedacht is dat het misschien een timing probleem is ivm wanneer de recordset geüpdate wordt.
tb0ne
Elite Poster
Elite Poster
Berichten: 1020
Lid geworden op: 24 aug 2012, 11:49
Uitgedeelde bedankjes: 27 keer
Bedankt: 85 keer

Je zal de wat te doen bij deelbaar door 50 logica best in je bewaar knop steken en niet in een form event vermoedelijk...
Gebruikersavatar
Mortov Molotov
Pro Member
Pro Member
Berichten: 341
Lid geworden op: 07 jan 2012, 10:57
Uitgedeelde bedankjes: 88 keer
Bedankt: 34 keer
Recent bedankt: 4 keer

cptKangaroo schreef:Als je zeker bent dat ie niet één van die 'exit sub' statements gebruikt in die situatie, dan vermoed ik dat er nog ergens een auto-increment aanstaat die er nog eentje bijlapt bij NrTxt zonder daarbij door je If statement te gaan, omdat je die NrTxt waarde blijkbaar ophaalt vanuit de recordset:

NrTxt = RS(NrTxt.ControlSource) + 1

Een ander gedacht is dat het misschien een timing probleem is ivm wanneer de recordset geüpdate wordt.
Heb eea geprobeerd & nagekeken, doch zonder resultaat:
- auto-increment staat enkel zoals gebruikelijk aan in het ID field, nergens anders
- timing lijkt het ook niet te zijn, als ik trager een nieuw record kies, gebeurt hetzelfde

tb0ne schreef:Je zal de wat te doen bij deelbaar door 50 logica best in je bewaar knop steken en niet in een form event vermoedelijk...
Heb ik ook al aan gedacht, doch ergonomisch iets minder handig natuurlijk; het doel was om vlot getuigschriftjes 1 -> 50 in te vullen, om dan terug op 1 te springen, met verder lege velden, ipv. naar 51 te gaan, een nr. wat niet bestaat bij getuigschriften in deze context.
Gebruikersavatar
cptKangaroo
Elite Poster
Elite Poster
Berichten: 3057
Lid geworden op: 18 dec 2004, 14:33
Locatie: 053 Aalst
Uitgedeelde bedankjes: 666 keer
Bedankt: 227 keer
Recent bedankt: 2 keer

Met 'timing' bedoelde ik niet echt een tijdstip, maar een trigger waardoor de database zich update. Forceer dat eens door na iedere interactie met de recordset een refresh te doen, en voor de zekerheid ook eentje na de If statement.
Gebruikersavatar
Mortov Molotov
Pro Member
Pro Member
Berichten: 341
Lid geworden op: 07 jan 2012, 10:57
Uitgedeelde bedankjes: 88 keer
Bedankt: 34 keer
Recent bedankt: 4 keer

Feeling like a dumbass now.

Maar goed, n00b zijnde, had ik nog enkele vragen hierbij:
- bedoel je dan zoiets als me.refresh?
- en hoe koppel je dat tot de painting status?
Gebruikersavatar
cptKangaroo
Elite Poster
Elite Poster
Berichten: 3057
Lid geworden op: 18 dec 2004, 14:33
Locatie: 053 Aalst
Uitgedeelde bedankjes: 666 keer
Bedankt: 227 keer
Recent bedankt: 2 keer

Niet de applicatie, maar de Recordset zelf. Bijvoorbeeld: voeg een RS.Update lijn toe na iedere lijn waar je iets met die recordset doet.

Mijn gedacht was dat die RS zichzelf pas updatet als er iets mee gedaan wordt, en je NrTxt waarde dus misschien niet altijd up-to-date was op de momenten waar je dat verwachtte.

Ik zou het ook iets anders doen, namelijk:

Code: Selecteer alles

    NrTxt = RS(NrTxt.ControlSource) 

   If (NrTxt Mod 50) <> 0 Then
    BookCombo = RS(BookCombo.ControlSource)
    CDateTxt = RS(CDateTxt.ControlSource)
    NrTxt = NrTxt + 1
   Else
    NrTxt = 1
   End If
En dan achteraf de nieuwe NrTxt in de RS schrijven.
Gebruikersavatar
Mortov Molotov
Pro Member
Pro Member
Berichten: 341
Lid geworden op: 07 jan 2012, 10:57
Uitgedeelde bedankjes: 88 keer
Bedankt: 34 keer
Recent bedankt: 4 keer

IT WORKS :banana:


Dit is de code, springt na record 50 terug naar 1:

Code: Selecteer alles

Dim RS As DAO.Recordset
      
   On Error Resume Next
   
   ' Exit if not on the new record.
   If Not NewRecord Then Exit Sub
   
   ' Goto the last record of the form recordset (to autofill form).
   Set RS = RecordsetClone
   RS.MoveLast
      
   NrTxt = RS(NrTxt.ControlSource)
   
   If (NrTxt Mod 50) <> 0 Then
    BookCombo = RS(BookCombo.ControlSource)
    CDateTxt = RS(CDateTxt.ControlSource)
    NrTxt = NrTxt + 1
    RS.Update
   Else
    NrTxt = 1
    RS.Update
   End If
Gebruikersavatar
cptKangaroo
Elite Poster
Elite Poster
Berichten: 3057
Lid geworden op: 18 dec 2004, 14:33
Locatie: 053 Aalst
Uitgedeelde bedankjes: 666 keer
Bedankt: 227 keer
Recent bedankt: 2 keer

Goed dat het werkt want 't is van 2001 geleden dat ik nog iets met VBA deed en je code was eigenlijk correct :beerchug:
Gebruikersavatar
Mortov Molotov
Pro Member
Pro Member
Berichten: 341
Lid geworden op: 07 jan 2012, 10:57
Uitgedeelde bedankjes: 88 keer
Bedankt: 34 keer
Recent bedankt: 4 keer

Ik denk erover dit open source te delen onder GPL of Creative Commons licensie. Jullie zullen worden vermeld :wink:
Plaats reactie

Terug naar “Software en apps”