Automatische datum in formulier

[IngeJ]

Beste VBA wizzards,

Kunnen jullie mij helpen met het volgende:
Ik heb een database gebouwd in Excel (wij hebben geen Acces). In de database heb ik een aantal formulieren gemaakt, onder andere 1 om nieuwe participanten toe te voegen. In het formulier moet een aanvangsdatum ingevuld worden en een einddatum.

Nu krijg ik van de gebruikers de vraag of de einddatum in het formulier automatisch een jaar na de aanvangsdatum kan worden. Kan iemand mij daarmee helpen?

Alvast bedankt!

Inge

 

[OctaFish]

In welk formulier moet dat komen?

 

[IngeJ]

In het formulier "Nieuwe participant"

 

[OctaFish]

Dan is het duidelijk:

Private Sub txtaanmelding_AfterUpdate()
    Me.txtuitstroom = DateAdd("yyyy", 1, CDate(Me.txtaanmelding))
End Sub

 

[edmoor]

Of met foutcontrole:

Private Sub txtaanvang_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    On Error GoTo Fout
    txtuitstroom.Text = DateAdd("yyyy", 1, CDate(txtaanvang.Text))
    Exit Sub
    
Fout:
    If txtaanvang.Text <> "" Then
        MsgBox "Incorrecte datum: " & txtaanvang.Text, vbCritical
        Cancel = True
    End If
End Sub

In dit geval gebruik ik de Datum aanvang.
De textbox wordt niet verlaten als er geen geldige datum is ingegeven.

 

[IngeJ]

Super bedankt Octafish, precies wat ik wilde!

Inge

 

[IngeJ]

Bedankt voor het meedenken ook Edmoor, heb de code van Octafish al in mijn bestand gezet maar ga die van jouw ook nog even proberen!

Inge

 

[OctaFish]

Ik zou, als je toch een foutafvanging inbouwt, niet checken op een leeg tekstveld, maar of het veld ook daadwerkelijk een datum bevat. Je hebt namelijk niks aan een veld dat de tekst "abd" bevat; dat is niet leeg maar zal toch geen datum opleveren.

Private Sub txtaanmelding_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    On Error GoTo Fout
    Me.txtuitstroom.Text = DateAdd("yyyy", 1, CDate(Me.txtaanmelding.Text))
    Exit Sub
    
Fout:
    If Not IsDate(txtaanvang.Text) Then
        MsgBox "Incorrecte datum: " & Me.txtaanvang.Text, vbCritical
        Me.txtaanmelding = Null
        Cancel = True
    End If
End Sub

 

[edmoor]

Helemaal correct

 

[OctaFish]

Altijd het laatste woord