verwijzein binnen dezelfde module

[JEPEDEWE]

Ik heb een form met 3 drukknoppen
99% van de code is identiek
Ik vroeg me dus af of ik die code niet ergens kon plaatsen en er in de "Private sub" dan kan naar verwijzen
de "unieke lijn is dan:
'DoCmd.RunSQL "UPDATE Betalingen SET Betalingen.BETAALD = True, Betalingen.Nog_te_betalen = 0, Betalingen.Datum_betaling = Date(), Betalingen.Manier = 'C' WHERE (((Betalingen.pingping)=True));"
Ik hoef alleen Betalingen.Manier = 'C' te veranderen in 'O' of 'S'

Hoe doe je dat?

Private Sub Cash_Click()
    Dim Getuigschriften As String
    Dim SQL As String
    Dim SQL2 As String
    Dim i As Integer
    SQL = "SELECT REFERENTIE FROM Betalingen WHERE (Betalingen.pingping)=True;"
    With CurrentDb.OpenRecordset(SQL)
        .MoveLast
        .MoveFirst
        Do While Not .EOF
            If i < .RecordCount And Not Getuigschriften = "" Then Getuigschriften = Getuigschriften & "- "
            Getuigschriften = Getuigschriften & !REFERENTIE
            .MoveNext
            i = i + 1
        Loop
    End With
    SQL2 = "Select Dossier.code, Dossier.tekst, Dossier.datum from dossier where dossier.code = '" & Me!Kode_patient & "';"
    With CurrentDb.OpenRecordset(SQL2)
        If .RecordCount <> 0 Then
        .Edit
        .AddNew
        !DATUM = Date
        !CODE = Me!Kode_patient
        !Tekst = "   -->" & Getuigschriften & " werd betaald op " & Date
        .Update
        End If
    End With

    'DoCmd.RunSQL "UPDATE Betalingen SET Betalingen.BETAALD = True, Betalingen.Nog_te_betalen = 0, Betalingen.Datum_betaling = Date(), Betalingen.Manier = 'C' WHERE (((Betalingen.pingping)=True));"
    Me!naamlijst.SetFocus
    Me!Cash.Visible = False
    Me!Overschrijving.Visible = False
    Me!Speciaal.Visible = False
    Me!Stoppen.Visible = False
    Me!Printen.Visible = True
    Me!Vermist.Visible = True
    Me!Printen.Visible = True
    Me!Stop_main.Visible = True
    Me![te betalen getuigschriften].Enabled = True
    Me!Manier.Visible = False
End Sub

 

[OctaFish]

Je kunt van de hele procedure een functie maken. Die ziet er dan, (gelijk je code maar weer een beetje opgeschoond) zo uit:

Function Cash(frm As Form, Waarde As String)
Dim Getuigschriften As String
Dim SQL As String
Dim i As Integer
    SQL = "SELECT REFERENTIE FROM Betalingen WHERE pingping=True;"
    With CurrentDb.OpenRecordset(SQL)
        .MoveLast
        .MoveFirst
        Do While Not .EOF
            If i < .RecordCount And Not Getuigschriften = "" Then Getuigschriften = Getuigschriften & "- "
            Getuigschriften = Getuigschriften & !REFERENTIE
            .MoveNext
            i = i + 1
        Loop
        .Close
    End With
    
    SQL = "SELECT code, tekst, datum FROM dossier WHERE code = '" & Me!Kode_patient & "';"
    With CurrentDb.OpenRecordset(SQL)
        If .RecordCount <> 0 Then
        .Edit
        .AddNew
        !DATUM = Date
        !CODE = Me!Kode_patient
        !Tekst = Getuigschriften & " werd betaald op " & Date
        .Update
        End If
    End With

    DoCmd.RunSQL "UPDATE Betalingen SET BETAALD = True, Nog_te_betalen = 0, Datum_betaling = Date(), Manier = '" & Waarde & "' WHERE (pingping=True);"
    With frm
        .naamlijst.SetFocus
        .Cash.Visible = False
        .Overschrijving.Visible = False
        .Speciaal.Visible = False
        .Stoppen.Visible = False
        .Printen.Visible = True
        .Vermist.Visible = True
        .Stop_main.Visible = True
        .[te betalen getuigschriften].Enabled = True
        .Manier.Visible = False
    End With
End Function

En je roept hem dan zo aan:

 Call Cash(Me, "c")

Niet getest allemaal, want ik mis de db.

 

[JEPEDEWE]

Het komt niet slim met je code
Als ik die vooraan in de code van de module steek, na "Option Compare Database" dan krijg ik een messagebox zoals figuur 1... nadien figuur 2 dan pas opent de form zich met een leeg keuzeveld
Doe ik je code weg dan opent de form zich zonder foutmeldingen
What to do?

JP

 

[OctaFish]

Je kent het recept: een voorbeeldje

 

[JEPEDEWE]

Stuurde bestand op....
zit al te wippen van ongeduld op het verdict
JP

 

[OctaFish]

De functie is niet veel meer dan dit:

Function BetalingBijwerken(frm As Form, Waarde As String)
Dim SQL As String
    
    SQL = "UPDATE Betalingen SET BETAALD = True, Nog_te_betalen = 0, " _
        & "Datum_betaling = Date(), Manier = '" & Waarde & "' WHERE (pingping=True);"
    CurrentDb.Execute SQL, dbFailOnError
    With frm
        .naamlijst.SetFocus
        .Cash.Visible = False
        .Overschrijving.Visible = False
        .Speciaal.Visible = False
        .Stoppen.Visible = False
        .Printen.Visible = True
        .Vermist.Visible = True
        .Stop_main.Visible = True
        .te_betalen_getuigschriften.Enabled = True
        .Manier.Visible = False
    End With

End Function

En je gebruikt hem zo op de knoppen:

Private Sub Cash_Click()
    Call BetalingBijwerken(Me, "C")
End Sub

Private Sub Overschrijving_Click()
    Call BetalingBijwerken(Me, "O")
End Sub

Private Sub Speciaal_Click()
    Call BetalingBijwerken(Me, "S")
End Sub

 

[JEPEDEWE]

Het werkt, en flitsend snel...
Wat deed in nu eigenlijk fout?
JP

 

[OctaFish]

De naam van je functie was gelijk aan de naam van een knop. Dat was al niet heel handig. Verder heb ik alleen de noodzakelijke code in de functie gezet: het updaten van de tabel.