Imputbox avec date

Bonsoir le forum

Existe t il un moyen de contrôler une date ou un mois dans une imputbox exemple ( nomdossier = Application.InputBox(prompt:="ENTREZ MOIS ?", Type:=2) exemple nous sommes au mois de novembre et une personne écrit décembre possible mettre un message .

Merci

CDT

Bonjour,

Une piste :

Sub Test()

    Dim Retour
    Dim I As Integer
    Dim OK As Boolean

    Retour = Application.InputBox(prompt:="ENTREZ MOIS ?", Type:=2)

    For I = 1 To 12

        If UCase(Retour) = UCase(MonthName(I)) Then OK = True: Exit For

    Next I

    If OK = False Then MsgBox "Vous devez entrer le nom du mois en entier !": Exit Sub

    MsgBox "C'est bon !" '<--- à virer, c'est pour le test !

    'ici, le reste du code si le nom d'un mois est correct !
    '...
    '...

End Sub

Bonsoir THEZE

Merci de vous intéressiez à mon problème super code, sauf que j'ai déjà nom dossier = application enfin voila la suite de la macro pour meilleure compréhension.

Merci

cdt

Sub enregistrer()

'

Dim Retour

Dim I As Integer

Dim OK As Boolean

'nomdossier = Application.InputBox(prompt:="ENTREZ MOIS ?", Type:=2)

Retour = Application.InputBox(prompt:="ENTREZ MOIS ?", Type:=2)

For I = 1 To 12

If UCase(Retour) = UCase(MonthName(I)) Then OK = True: Exit For

Next I

If OK = False Then MsgBox "Vous devez entrer le nom du mois en entier !": Exit Sub

MsgBox "C'est bon !" '<--- à virer, c'est pour le test !

'ici, le reste du code si le nom d'un mois est correct !

dossier = "O:\Users\etc\etc

test_repertoire (dossier)

Sheets("TABLEAU").Select

Range("A2:K182").Select

ActiveSheet.PageSetup.PrintArea = "$A$2:$K$182"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

dossier & Range("B1").Value & "-" & "Période du " & Format(Date, "dd-mm-yyyy") & " au " & Format(Range("G1"), "dd-mm-yyyy") & "_" & Format(Time, "hh-mm") & " heure" & "-" & " semaine " & Format(Now, "ww") & ".pdf", Quality:=xlQualityStandard, _

Bonjour,

Tu ne peux pas ouvrir un classeur suite à un InputBox() sans avoir au préalable fais des tests de validité comme par exemple la macro que le t'ai donné.

Il te faut ensuite construire ton chemin puis tester avec Dir() si le fichier se trouve bien dans le dossier indiqué, si c'est oui, tu ouvres sinon, tu affiche à nouveau un message !

Sub enregistrer()

    Dim I As Integer
    Dim OK As Boolean
    Dim Dossier As String
    Dim Fichier As String

    Fichier = Application.InputBox(prompt:="ENTREZ MOIS ?", Type:=2)

    For I = 1 To 12

        If UCase(Fichier) = UCase(MonthName(I)) Then OK = True: Exit For

    Next I

    If OK = False Then MsgBox "Vous devez entrer le nom du mois en entier !": Exit Sub

    Dossier = "O:\Users\etc\etc\" 'ne pas oublier le dernier anti-slash !
    Fichier = Fichier & ".xlsx" 'ajout de l'extension, à adapter !

    'contrôle la présence du fichier dans le dossier
    If Dir(Dossier & Fichier) = "" Then MsgBox "Le fichier '" & Fichier & "' ne se trouve pas dans le dossier '" & Dossier & "' !": Exit Sub

    'ici, la suite du code si le fichier existe et se trouve dans le bon dossier...

End Sub

PS le code doit être collé entre les balises CODE et non après !

Bonsoir THEZE

Merci de votre aide sympa tout marche nickel, juste existe-t-il une possibilité pour que la personne puisse recommencer à écrire le mois si par inadvertance elle s'est trompé ? Merci encore cdt

Bonjour,

Voir ceci :

Sub enregistrer()

    Dim I As Integer
    Dim OK As Boolean
    Dim Dossier As String
    Dim Fichier As String

    Do

        Fichier = Application.InputBox(prompt:="ENTREZ MOIS ?", Type:=2)

        For I = 1 To 12

            If UCase(Fichier) = UCase(MonthName(I)) Then OK = True: Exit For

        Next I

       If OK = False Then MsgBox "Vous devez entrer le nom du mois en entier !"

    Loop While OK <> True

    Dossier = "O:\Users\etc\etc\" 'ne pas oublier le dernier anti-slash !
    Fichier = Fichier & ".xlsx" 'ajout de l'extension, à adapter !

    'contrôle la présence du fichier dans le dossier
    If Dir(Dossier & Fichier) = "" Then MsgBox "Le fichier '" & Fichier & "' ne se trouve pas dans le dossier '" & Dossier & "' !": Exit Sub

    'ici, la suite du code si le fichier existe et se trouve dans le bon dossier...

End Sub

Bonsoir

Merci de votre aide .

CDT