Format précis accepté dans une InputBox

Bonsoir,

Lors d'une procédure, les utilisateurs doivent indiquer, par l'intermédiaire d'une InputBox, quel est le mois et l'année concernés sous la forme MM.AAAA.

Comment puis-je transformé le code ci-dessous de manière à ce qu'un message d'erreur du genre "Vous devez entrer une date au format MM.AAAA" apparaisse si une date inadaptée est saisie, par exemple : 1.2008, ou 01.08 à la place de 01.2008 ou une date avec des vigules à la place des points ou je ne sais quoi encore ?

        Dim message As String, title As String, default As String, Date_décompte As String

        Application.ScreenUpdating = False

        chemin = "C:\Users\LACY\Documents\Y\AG - PK Post"

        message = "Décompte de MM.AAAA ??"
        title = ""
        default = ""
        Date_décompte = InputBox(message, title, default)

Avec mes bonnes salutations

Salut le forum

Yvouille, ajout après ton InputBox le code suivant :

If Not Date_décompte Like "##.####" Then
  MsgBox ("Saisie non valide")
  Exit Sub
End If

Mytå

Bonsoir,

Bonsoir, Mytå

une autre solution, qui contrôle qu'il y a bien 7 caractères, un point en troisième position, une année valable (supérieure à 1900), et un mois valable (de 1 à 12)

Sub test()
retour:
    DV = InputBox("Date à vérifier")
    If DV = "" Then Exit Sub
    If Not (DateValide(DV)) Then
        MsgBox "Format non valable": GoTo retour
    Else
        MsgBox "OK"
    End If
End Sub

Function DateValide(DV)
Dim M, A
   DateValide = False
   On Error GoTo Fin
   If Len(DV) - Len(Application.Substitute(CStr(DV), ".", "")) <> 1 Or Len(DV) <> 7 Or InStr(1, DV, ".") <> 3 _
       Then Exit Function
   M = Left(DV, 2)
   A = Right(DV, 4)
   If A < 1900 Then Exit Function
   If M < 1 Or M > 12 Then Exit Function
   DateValide = True
Fin:
End Function

Merci à tous deux pour vos propositions.

Je vais faire des essais afin de voir lequel de vos codes me convient le mieux.

Ca risque de prendre quelques jours, mais je ne manquerais pas de vous tenir au courant.

Merci déjà pour votre aide et bonne soirée.

Felix, Myta,

Pour l’instant je préférerais utiliser la solution de Felix qui me paraît plus complète puisqu’elle effectue plus de contrôles. Par contre, je ne sais pas si je l’utilise correctement, selon le code reporté ci-dessous. J’ai placé la Sub test () proposée par Felix juste après le code concernant l’InputBox et la Function DateValide(DV) après ma Sub Recherche_FichierMoisPrécédent_CopierFeuille_RefermerFichierMoisPrécédent().

Tout fonctionnerait bien, si ce n’est deux problèmes :

1) Il n’est pas accepté d’indiquer dans la InputBox une date comportant le mois de décembre. Si j’indique par exemple que je veux traiter le décompte du mois 12.2007, un message d’erreur est alors illogiguement renvoyé.

2) Alors qu’avant ma macro fonctionnait bien, maintenant ce n’est plus le décompte du mois précédent qui est ouvert par la ligne

Workbooks.Open Filename:=chemin & "\" & annee1 & "_" & vmois1 & "_Quellensteuer" & ".xls"

, mais celui du mois d’avant.! Ainsi si j’indique dans la InputBox que je veux traiter le décompte du mois 03.2008, c’est le décompte du 01.2008 qui est trouvé comme décompte du mois précédent à la place de celui du 02.2008.

Pouvez-vous encore me dire ce qui ne va pas ?

Sub Recherche_FichierMoisPrécédent_CopierFeuille_RefermerFichierMoisPrécédent()

Dim v_date, v_mois
Dim DV As String ' Rajout d'Yvouille pour la proposition de Felix pour contrôle de l'inscription dans la InputBox

'   Ouvre automatiquement le fichier du mois précédent,
'   enregistre le nom de ce fichier afin de le refermer ci-après,
'   copie et transfert la feuille des données du mois passé dans ce fichier,
'   referme le fichier du mois précédent et renomme la feuille déplacée

'           pour ouvrir le fichier du mois précédent

        Dim message As String, title As String, default As String, Date_décompte As String

        Dim annee1 As String 

        Application.ScreenUpdating = False

        chemin = "C:\Users\LACY\Documents\Yvouille\AG - PK Post"

        message = "Décompte de MM.AAAA ??"
        title = ""
        default = ""
        Date_décompte = InputBox(message, title, default)

‘’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’'''''Sub test()
retour:
    DV = InputBox("Date à vérifier")
    If DV = "" Then Exit Sub
    If Not (DateValide(DV)) Then
        MsgBox "Format non valable": GoTo retour
    Else
        MsgBox "OK"
    End If
'’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’'''End Sub

        vmois = Left(Date_décompte, 2)
        annee = Right(Date_décompte, 4)
        Select Case vmois
            Case "0" & 2 To 10
            vmois1 = "0" & vmois - 1
            annee1 = annee ' rajout de Yvouille
            Case Is = "0" & 1
            vmois1 = 12
            annee1 = annee - 1
            Case Is > 10
            vmois1 = vmois - 1
            annee1 = annee ' rajout de Yvouille
            Case ""
            Exit Sub
        End Select
        Workbooks.Open Filename:=chemin & "\" & annee1 & "_" & vmois1 & "_Quellensteuer" & ".xls"

End Sub

Function DateValide(DV) ' Va avec la proposition de Felix pour contrôle de l'inscription dans la InputBox
Dim M, A
   DateValide = False
   On Error GoTo Fin
   If Len(DV) - Len(Application.Substitute(CStr(DV), ".", "")) <> 1 Or Len(DV) <> 7 Or InStr(1, DV, ".") <> 3 _
       Then Exit Function
   M = Left(DV, 2)
   A = Right(DV, 4)
   If A < 1900 Then Exit Function
   If M < 1 Or M > 12 Then Exit Function
   DateValide = True
Fin:
End Function

Bonnes salutations à vous tous

Rebonjour,

Je me suis rendu compte d'un autre problème a propos de ce travail. Apparament je dois à chaque fois entrer deux dates dans la InputBox, la première étant systématiquement refusée.

Veuillez alors ne plus consacrer de temps à cette question tant que je n'ai pas pu faire d'essais complémentaire.

Merci et bonne journée

Felix, Mytå,

J’ai finalement trouvé mon erreur.

Dans le code présenté ci-dessus, j’ai deux InputBox en parallèle car j’avais cru que la proposition de Felix était semblable à celle de Mytå, c'est-à-dire en complément à mon code et non pas en remplacement.

Je devais donc effectivement entrer deux fois l’information sur la date - une fois dans mon InputBox, une fois dans celle de Felix - et les deux informations récoltés étaient utilisées à deux endroits différents, créant les divers problèmes indiqués.

Vous avez alors parfaitement répondu à mon attente et je tiens à vous en remercier sincèrement.

Bonne fin de journée.