Microsoft 365 Problème de date

PORCHER à dit:

Bonjour à tous, Je fais appel à vous pour résoudre mon problème : Je souhaiterais afficher dans un TextBox (TxtDateProchainCT) la date du prochain contrôle.
dans le TextBox il affiche 29/10/1900, c'est incohérent. Voici ci dessous la macro
Pourriez vous m'aider, merci

VB:

Private Sub CalculValid2()
 Dim dtAujourdhui As Date
 Dim dtAutreDate As Date
 Dim Formule As Integer
 
 On Error Resume Next
    dtAutreDate = CDate(UF_Interventions.TxtDateContrôleTech.Value)
    dtAujourdhui = Now()
 On Error GoTo 0
 
 If dtAujourdhui <= dtAutreDate Then
    zv_Msg = MsgBox("La date de fin ne peut pas être antérieure à la date de début ...", 48, vb_Cprht & " - " & vs_Ori & " - Erreur")
    Exit Sub
End If

If dtAutreDate <= dtAujourdhui Then
   Formule = Day(DateSerial(Year(dtAutreDate), Month(dtAutreDate) + 24, 1) - 1)
   UF_Interventions.TxtDateProchainCT.Text = Formule
   UF_Interventions.LbSuiviPriorite1.BackColor = &HFF&  'rouge
Else: UF_Interventions.LbSuiviPriorite1.BackColor = &HFF00&: End If

If TxtDerniereVidange.Value <= dtAujourdhui Then
    UF_Interventions.LbSuiviPriorite2.BackColor = &HFF&  'rouge
    Else: UF_Interventions.LbSuiviPriorite2.BackColor = &HFF00&: End If
  
If TxtDateCourroie.Value <= dtAujourdhui Then
    UF_Interventions.LbSuiviPriorite3.BackColor = &HFF& 'Rouge
    Else: UF_Interventions.LbSuiviPriorite3.BackColor = &HFF00&: End If

End Sub

Cliquez pour agrandir...

Private Sub CalculValid2()
    Dim dtAujourdhui As Date
    Dim dtAutreDate As Date
    Dim dtProchainCT As Date
    
    On Error Resume Next
        dtAutreDate = CDate(UF_Interventions.TxtDateContrôleTech.Value)
        dtAujourdhui = Now()
    On Error GoTo 0

    If dtAujourdhui <= dtAutreDate Then
        MsgBox "La date de fin ne peut pas être antérieure à la date de début ...", 48, "Erreur"
        Exit Sub
    End If

    If dtAutreDate <= dtAujourdhui Then
        ' Ajouter 2 ans (24 mois) à la date du dernier contrôle
        dtProchainCT = DateAdd("m", 24, dtAutreDate)
        UF_Interventions.TxtDateProchainCT.Text = Format(dtProchainCT, "dd/mm/yyyy")
        UF_Interventions.LbSuiviPriorite1.BackColor = &HFF&  ' rouge
    Else
        UF_Interventions.LbSuiviPriorite1.BackColor = &HFF00& ' vert
    End If

    If CDate(TxtDerniereVidange.Value) <= dtAujourdhui Then
        UF_Interventions.LbSuiviPriorite2.BackColor = &HFF& ' rouge
    Else
        UF_Interventions.LbSuiviPriorite2.BackColor = &HFF00& ' vert
    End If

    If CDate(TxtDateCourroie.Value) <= dtAujourdhui Then
        UF_Interventions.LbSuiviPriorite3.BackColor = &HFF& ' rouge
    Else
        UF_Interventions.LbSuiviPriorite3.BackColor = &HFF00& ' vert
    End If
End Sub

halecs93 à dit:

VB:

Private Sub CalculValid2()
    Dim dtAujourdhui As Date
    Dim dtAutreDate As Date
    Dim dtProchainCT As Date
   
    On Error Resume Next
        dtAutreDate = CDate(UF_Interventions.TxtDateContrôleTech.Value)
        dtAujourdhui = Now()
    On Error GoTo 0

    If dtAujourdhui <= dtAutreDate Then
        MsgBox "La date de fin ne peut pas être antérieure à la date de début ...", 48, "Erreur"
        Exit Sub
    End If

    If dtAutreDate <= dtAujourdhui Then
        ' Ajouter 2 ans (24 mois) à la date du dernier contrôle
        dtProchainCT = DateAdd("m", 24, dtAutreDate)
        UF_Interventions.TxtDateProchainCT.Text = Format(dtProchainCT, "dd/mm/yyyy")
        UF_Interventions.LbSuiviPriorite1.BackColor = &HFF&  ' rouge
    Else
        UF_Interventions.LbSuiviPriorite1.BackColor = &HFF00& ' vert
    End If

    If CDate(TxtDerniereVidange.Value) <= dtAujourdhui Then
        UF_Interventions.LbSuiviPriorite2.BackColor = &HFF& ' rouge
    Else
        UF_Interventions.LbSuiviPriorite2.BackColor = &HFF00& ' vert
    End If

    If CDate(TxtDateCourroie.Value) <= dtAujourdhui Then
        UF_Interventions.LbSuiviPriorite3.BackColor = &HFF& ' rouge
    Else
        UF_Interventions.LbSuiviPriorite3.BackColor = &HFF00& ' vert
    End If
End Sub

Cliquez pour agrandir...

PORCHER à dit:

Merci halecs93, la macro fonctionne parfaitement, merci, merci. Problème résolu

Cliquez pour agrandir...