Saisie de date avant de poursuivre la macro

Bonjour,

J'ai une macro pour enregistrer un fichier dans un dossier.

Si la cellule I1 n'est pas renseigné (il s'agit d'une date), je voudrais qu'une inputbox me propose de saisir la date et la renvoi dans la cellule I1 avant de pouvoir enregistrer le fichier.

Voici mon code :

Sub Enregistrer()

Dim LaDate As String

LaDate = Format(Date, "dd" & "." & "mm" & "." & "yyyy")

ChDir _
"P:\MARCHES\23M02 - Lessiviel - Entretien - Hygiène - EPI\BDC\Nouveau dossier"
ActiveWorkbook.SaveAs Filename:= _
"P:\MARCHES\23M02 - Lessiviel - Entretien - Hygiène - EPI\BDC\Nouveau dossier\BDC HERSAND" & Range("E7") & " du " & LaDate & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

MsgBox "Bon de commande exporté dans le dossier A engager", vbInformation, "Fin de traitement"

End Sub

Bonjour,

Voici un code à vérifier si cela correspond à votre demande.

Sub Enregistrer()

    ' Vérifier si la cellule I1 est vide
    If Range("I1").Value = "" Then
        ' Si la cellule I1 est vide, demander à l'utilisateur de saisir une date
        Dim userInput As Variant
        userInput = InputBox("Veuillez saisir la date (format dd/mm/yyyy) :", "Saisir la date")

        ' Vérifier si l'utilisateur a appuyé sur Annuler ou n'a rien saisi
        If userInput = "" Or userInput = False Then
            MsgBox "Vous devez saisir une date pour continuer.", vbExclamation, "Erreur"
            Exit Sub
        End If

        ' Vérifier si la date saisie est valide
        If Not IsDate(userInput) Then
            MsgBox "La date saisie n'est pas valide. Veuillez saisir une date au format dd/mm/yyyy.", vbExclamation, "Erreur"
            Exit Sub
        End If

        ' Mettre à jour la cellule I1 avec la date saisie
        Range("I1").Value = userInput
    End If

    Dim LaDate As String
    LaDate = Format(Range("I1").Value, "dd" & "." & "mm" & "." & "yyyy")

    ChDir _
    "P:\MARCHES\23M02 - Lessiviel - Entretien - Hygiène - EPI\BDC\Nouveau dossier"
    ActiveWorkbook.SaveAs Filename:= _
    "P:\MARCHES\23M02 - Lessiviel - Entretien - Hygiène - EPI\BDC\Nouveau dossier\BDC HERSAND" & Range("E7") & " du " & LaDate & ".xlsm" _
    , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

    MsgBox "Bon de commande exporté dans le dossier A engager", vbInformation, "Fin de traitement"

End Sub

Bonne journée,

Oiseau bleu

Merci beaucoup. Cela fonctionne très bien.