code-fout

[Tamara27]

Ik vrees dat er een foutje is opgetreden in onderstaande code. Het rode gedeelte dan.
Hij slaat mooi de complicaties op, maar geeft altijd 1 extra record, waarvan enkel de unieke code wordt opgeslaan, de complicatie is leeg.
Ik heb al nagekeken of er nergens een verborgen checkbox is, maar dat is niet het geval.
Kan iemand mij misschien zeggen waar de fout zit?

Private Sub cmdVerder_Click()
Dim lResponse As Integer
Dim sUniekeCode As String

lResponse = MsgBox("Verder gaan?", vbYesNo, "Verder gaan")
If lResponse = vbYes Then

    If Nz(cmbCode, "") = "" Then
    MsgBox ("Vul de unieke code in aub")
    Exit Sub

    Else
    Dim sTabel As String
    Dim sComplicaties As String
    
        [COLOR="red"][B]For Each ctl In Controls
            With ctl
                Select Case .ControlType
                    Case acCheckBox
                        If .Value = -1 Then
                            sComplicaties = Mid(.Name, 9, Len(.Name) - 8)
                            sTabel = .Tag
                            On Error Resume Next
                            With CurrentDb.OpenRecordset(sTabel)
                                .AddNew
                                ![Unieke code] = cmbCode
                                ![Complicaties] = sComplicaties
                                ![Aandoeningen] = sComplicaties
                                ![Aantasting] = sComplicaties
                                .Update
                                .Close
                            End With
                        End If[/B] [/COLOR]                   
                 Case acComboBox
                        If .Value <> "" Then
                            sTabel = .Tag
                            On Error Resume Next
                            With CurrentDb.OpenRecordset(sTabel)
                                .AddNew
                                ![Unieke code] = cmbCode
                                ![Diagnosedatum] = txtDiagnosedatum
                                ![Type IBD] = cmbIBD
                                .Update
                                .Close
                            End With
                        End If
                End Select
            End With
        Next ctl
    
        
        If Me.txtAantalcm <> "" Then
        With CurrentDb.OpenRecordset("GegevensAantasting")
            .AddNew
            ![Unieke code] = cmbCode
            ![Aantasting] = txtAantalcm & " cm"
            .Update
            .Close
        End With
        ElseIf Me.txtOngedefinieerd <> "" Then
        With CurrentDb.OpenRecordset("GegevensAantasting")
            .AddNew
            ![Unieke code] = cmbCode
            ![Aantasting] = txtOngedefinieerd
            .Update
            .Close
        End With
        Else
        With CurrentDb.OpenRecordset("GegevensAantasting")
            .AddNew
            ![Unieke code] = cmbCode
            ![Aantasting] = cmbAantasting
            .Update
            .Close
        End With
        End If
        
    End If
    
    lResponse = MsgBox("Verder gaan naar Invoeren behandeling?", vbYesNo, "Verder gaan")
        If lResponse = vbYes Then
            sUniekeCode = Me.cmbCode
            DoCmd.Close acForm, "F_InvoerenIBD"
            DoCmd.OpenForm "F_InvoerenBehandeling", , , , , , sUniekeCode
        Else
            DoCmd.Close acForm, "F_InvoerenIBD"
            DoCmd.OpenForm "F_Start"
        End If

Else
    Exit Sub
End If
End Sub

 

[OctaFish]

Hebben we deze niet al opgelost in het Access forum? Zo ja; een topic graag in één forum zetten....