Attribute VB_Name = "Nouvelle_Date_v131"
'---------------------------------------------------------------------------------------
' Procédure_____: Nouvelle_Date décalée en Jour, Semaine, Mois, Trimestre, Année
' Date__________: 11/10/2021
' Auteur________: www.CapLSS.com - https://www.caplss.com/viewtopic.php?t=216
' Objet_________: Retourner une date ajustée en fonction d'un paramètre fournit
' Référence_____: Fonction générique
' Appel_________: Nouvelle_Date(Optional LaDate, Optional Ajuste, Optional PasdInfo)
' Retour________: Date valide ou 0
' Options_______: Si LaDate n'est pas fournie, prend la date du jour
' Options_______: Ajuste := <+/-><valeur><J/S/M/T/A> décale de la valeur fournie
' Options_______: Si PasdInfo := true, n'Affiche pas de message si une erreur est trouvée
' Compatibilité_: (2003-2019)Office     (11.0-16.0)Excel     (+)32-bit     (+)64-bit
' Statut________: (x)Validé ()En attente validation ()En cours développement
'---------------------------------------------------------------------------------------
' 2009.10.26 v1.00 DEV Création initiale, fournit la date ajustée en fonction d'un décalage fournit
' 2012.01.14 v1.10 DEV Passe Ajuste comme variable optionnelle. Ajoute une nouvelle unité (A: Année)
' 2021.03.19 v1.20 DEV Ajoute une nouvelle unité (T : Trimestre)
' 2021.03.26 v1.30 DEV Passe LaDate comme variable optionnelle (si non fournie, prend le jour système)
' 2021.11.10 v1.31 FIX Correction coquilles dans l'appel à la fonction et définition de PlusMoins
'
Option Explicit

Function Nouvelle_Date(Optional LaDate As Date, Optional Ajuste As String, Optional PasdInfo As Boolean) As Date
  '
  Dim EstErreur As Boolean
  Dim PlusMoins As Integer
  Dim Ajustement As Integer
  Dim Grandeur As String
  ' Garantit que LaDate est juste une date
  LaDate = Int(LaDate)
  If Not IsDate(LaDate) Then LaDate = 0
  ' Si la Date n'est pas fournie : ce jour
  If LaDate = 0 Then LaDate = Date
  ' Gestion des erreurs
  EstErreur = False
  ' Décalage demandé ?
  If Ajuste > "" Then
    ' Plus ou Moins ?
    Select Case Left(Ajuste, 1)
      Case "+"
        ' Ajoute
        PlusMoins = 1
      Case "-"
        ' Soustrait
        PlusMoins = -1
      Case Else
        EstErreur = True
    End Select
    ' De Combien ?
    Ajustement = Mid(Ajuste, 2, Len(Ajuste) - 2)
    If Not IsNumeric(Ajustement) Then
      EstErreur = True
    End If
    ' De quelle Unité ?
    Select Case UCase(Right(Ajuste, 1))
      Case "J"
        Grandeur = "Jour"
      Case "S"
        Grandeur = "Semaine"
      Case "M"
        Grandeur = "Mois"
      Case "T"
        Grandeur = "Trimestre"
      Case "A"
        Grandeur = "Année"
      Case Else
        EstErreur = True
    End Select
    ' Paramètre Incorrect ?
    If EstErreur Then
      Nouvelle_Date = 0
      ' Message ? (par défaut, si erreur)
      If (PasdInfo = False) Then
        MsgBox "L'Ajustement fournit : " & Ajuste & " n'est pas conforme." & Chr(10) & "Format Attendu : <+/-><valeur><J/S/M/T/A>", Buttons:=vbCritical, Title:="Impossible de Calculer la Nouvelle Date"
      End If
    Else
      ' Traitement !
      Select Case Grandeur
        Case "Jour"
          Nouvelle_Date = DateSerial(Year(LaDate), Month(LaDate), Day(LaDate) + PlusMoins * Ajustement)
        Case "Semaine"
          Nouvelle_Date = DateSerial(Year(LaDate), Month(LaDate), Day(LaDate) + PlusMoins * Ajustement * 7)
        Case "Mois"
          Nouvelle_Date = DateSerial(Year(LaDate), Month(LaDate) + PlusMoins * Ajustement, Day(LaDate))
        Case "Trimestre"
          Nouvelle_Date = DateSerial(Year(LaDate), Month(LaDate) + PlusMoins * Ajustement * 3, Day(LaDate))
        Case "Année"
          Nouvelle_Date = DateSerial(Year(LaDate) + PlusMoins * Ajustement, Month(LaDate), Day(LaDate))
      End Select
    End If
  Else
    ' Sans Ajustement, ne retourne que la Date
    Nouvelle_Date = LaDate
  End If
  '
End Function