Automatische datum in formulier

Status
Niet open voor verdere reacties.
I

IngeJ

Gebruiker
Lid geworden
23 jun 2016
Berichten
72
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
 

Bijlagen

  • Lege test Database Participanten.xlsm
    88,4 KB · Weergaven: 32
Dan is het duidelijk:
Code: 
Private Sub txtaanmelding_AfterUpdate()
    Me.txtuitstroom = DateAdd("yyyy", 1, CDate(Me.txtaanmelding))
End Sub
 
Of met foutcontrole:
Code: 
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.
 
Laatst bewerkt:
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
 
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.
Code: 
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
 
Helemaal correct :)
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan