Discussion :

[Passepartout007]

Bonjour Pierre Fauconnier,

Ton code est magnifique, cependant est t'il vraiment applicable à des imputbox, il est difficile pour moi de l'applique j'ai toujours un manque de variable.
Pourrais te me donner une indication me permettant l'appliqué a des imputbox, actuellement le code est appliqué a des textbox qui sont quand à eu un nom spécifique qui permet d'effectuer le code et la fonction getdate.

Voici le code en question dans un userforme se nemant usrchoicePeriod :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Option Explicit
 
Public Clicked As String
 
Private Sub btnValidate_Click()
  Clicked = "Validate"
  Me.Hide
End Sub
 
Property Get BeginDate() As Date
  BeginDate = getDate(tboBeginDate)
End Property
 
Property Get EndDate() As Date
  EndDate = getDate(tboEndDate)
End Property
 
 
Private Function getDate(tbo As MSForms.TextBox) As Date
  getDate = DateSerial(Right(tbo, 4), Mid(tbo, 4, 2), Left(tbo, 2))
End Function
 
Private Sub UserForm_Click()
 
End Sub

et dans un module 1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Option Explicit
 
Sub FilterTable()
  Dim Dates
  Dim BeginDate As Date
  Dim EndDate As Date
 
  Dates = getPeriodDates()
  BeginDate = Dates(0)
  EndDate = Dates(1)
 
  Range("tableau1").AutoFilter field:=2, Criteria1:=">=" & CLng(BeginDate), Criteria2:="<=" & CLng(EndDate)
 
End Sub
 
Function getPeriodDates()
  Dim RetValue(0 To 1)
 
  usrChoicePeriod.Show
  If usrChoicePeriod.Clicked = "Validate" Then
    With usrChoicePeriod
      RetValue(0) = .BeginDate
      RetValue(1) = .EndDate
    End With
  End If
  Unload usrChoicePeriod
  getPeriodDates = RetValue
End Function

Est t'il donc possible de l'appliquer a des imputbox ?
Cordialement,
Passepartout007

[Pierre Fauconnier]

L'avantage de découper ton code en fonctions à responsabilité unique, c'est que tu ne touches qu'à ce que tu dois remplacer si tu veux collecter tes dates autrement.

Pour utiliser des inputbox au lieu du userform, tu peux simplement remplacer la fonction getPeriodDates initiale par celle-ci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Function getPeriodDates()
  Dim RetValue(0 To 1)
  Dim strDate1 As String
  Dim strDate2 As String
 
  strDate1 = InputBox("Veuillez saisir la date de début au format jj/mm/yyyy")
  strDate2 = InputBox("Veuillez saisir la date de fin au format jj/mm/yyyy")
  RetValue(0) = DateSerial(Right(strDate1, 4), Mid(strDate1, 4, 2), Left(strDate1, 2))
  RetValue(1) = DateSerial(Right(strDate2, 4), Mid(strDate2, 4, 2), Left(strDate2, 2))
  getPeriodDates = RetValue
End Function

[Passepartout007]

Bonjour,

Voici le nouveau code suite à l'ajout de tes magnifique ligne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub FilterDate() 'Permet de filtré entre deux dates
' Déclaration de variable
  Dim Dates
  Dim BeginDate As Date
  Dim EndDate As Date
'Dates est égale au résultat de la fonction getPeriodDates
  Dates = getPeriodDates()
  BeginDate = Dates(0)
  EndDate = Dates(1)
  If BeginDate > EndDate Then tmp = BeginDate: BeginDate = EndDate: EndDate = tmp
 With Sheets("Base de données")
  .[A1].AutoFilter field:=31, Criteria1:=">=" & CLng(BeginDate), Criteria2:="<=" & CLng(EndDate)
 End With
End Sub
 
 
Function getPeriodDates() ' Fonction getPeriodDates
'Déclaration de variable
  Dim RetValue(0 To 1) 'Retvalue prend 0 et 1 comme valeur
  Dim strDate1 As String 'Première date
  Dim strDate2 As String 'Deuxieme date
 
  strDate1 = InputBox("Veuillez saisir la date de début au format jj/mm/yyyy") 'strDate1 Récupére dans ImputBox la date
  If strDate1 = "" Then Exit Function
  strDate2 = InputBox("Veuillez saisir la date de fin au format jj/mm/yyyy") 'strDate2 Récupére dans ImputBox la date
  If strDate2 = "" Then Exit Function
  RetValue(0) = DateSerial(Right(strDate1, 4), Mid(strDate1, 4, 2), Left(strDate1, 2))
  RetValue(1) = DateSerial(Right(strDate2, 4), Mid(strDate2, 4, 2), Left(strDate2, 2))
  getPeriodDates = RetValue
End Function

j'ai rajouté les deux lignes dans la fonction pour éviter les message d'erreur en cas de clic sur buttons annuler:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 If strDate1 = "" Then Exit Function 
 If strDate2 = "" Then Exit Function

Cependant il reste des failles si rien n'est entrée la ligne créées une erreur (bouton annulé) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
  BeginDate = Dates(0)
  EndDate = Dates(1)

Si l'on rentre n'importe quoi qui ne soit pas une date alors cela lance quand même le filtre et n'affiche plus rien sur le tableau Filtrer.

J'ai tenter :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
If IsDate(BeginDate) Or IsDate(EndDate) Then 
 Else: MsgBox "La date saisie est dans un mauvais format"

Mais cela ne fonctionne pas.
Comment éviter ses messages d'erreurs et relancer les imputboxs si c'est un mauvais format de saisie.
Sinon cela fonctionne parfaitement bien quand l'on reste à saisir les bonnes choses. Cependant l'erreur est humaine ^^

Cordialement,
Passepartout007

[patricktoulon]

bonjour passepartout
juste une petite parentheses accompagnée d'une proposition
elle vient du fait que pour moi ton operation n'est qu'une operation et tes deux date sont UN!! parametre
parti de la deux inputbox ca fait bizarre
alors puisque tu tien absolument a tes inputbox je t'en propose qu'un est c'est un double

1. il est concu avec un userform mais fonctionne comme un input box
2. il est bloquant comme un input box
3. il ne fait rien si tu lui fait un show tout seul autrement inutile sans la fonction
4. il te dit si la date1 ou 2 n'est pas valide
5. il t'empeche de taper n'importe quoi dans une certaine limite
6. le format ne peut qu'etre "dd/mm/yyyy" et rien d'autre
7. combien meme si tu arrivais a taper n'importe quoi se serait detecté
8. le retour dans l'apel est fait par dateserial dans la fonction

la reponse du inputdatebox serait alors soit l'avertissement pour le date 1 ou 2 ou "annuler" si tu ferme la croix ou click sur annuler
c'est basé sur le tutoriel de arkham 46 et les boites de dialog avec des userforms
demo

un petit fichier en exemple avec utilisation dans un module OU!!! a partir d'un autre userform

voila c'etait ton moment de récréation

[Pierre Fauconnier]

Comme je le disais dans un précédent message, il faut normalement contrôler la saisie.

Je te propose le code suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Sub FilterTable()
  Dim Dates
  Dim BeginDate As Date
  Dim EndDate As Date
 
  Dates = getPeriodDates()
  If IsArray(Dates) Then
    BeginDate = Dates(0)
    EndDate = Dates(1)
    Range("tableau1").AutoFilter field:=2, Criteria1:=">=" & CLng(BeginDate), Criteria2:="<=" & CLng(EndDate)
  Else
    MsgBox "Dates non valides"
  End If
 
End Sub
 
 
 
Function getPeriodDates()
  Dim Ok As Boolean
  Dim RetValue(0 To 1)
  Dim strDate1 As String
  Dim strDate2 As String
 
  strDate1 = InputBox("Veuillez saisir la date de début au format jj/mm/yyyy")
  strDate2 = InputBox("Veuillez saisir la date de fin au format jj/mm/yyyy")
  RetValue(0) = StringToDate(strDate1)
  RetValue(1) = StringToDate(strDate2)
  If RetValue(0) > 0 And RetValue(1) > 0 Then
    getPeriodDates = RetValue
  Else
    getPeriodDates = 0
  End If
End Function
 
Function StringToDate(Value As String) As Date
  Dim Ok As Boolean
  Dim YearValue As Long
  Dim MonthValue As Long
  Dim DayValue As Long
 
  Ok = True
  If Not Value Like "##/##/####" And Not Value Like "##-##-####" Then
    Ok = False
  Else
    YearValue = Right(Value, 4) * 1
    MonthValue = Mid(Value, 4, 2) * 1
    DayValue = Left(Value, 2) * 1
    If YearValue < 1900 Then
      Ok = False
    Else
      Select Case MonthValue
        Case 1, 3, 5, 7, 8, 10, 12
          If DayValue > 31 Then Ok = False
        Case 4, 6, 9, 11
          If DayValue > 30 Then Ok = False
        Case 2
          If YearValue Mod 400 = 0 Or (YearValue Mod 100 <> 0 And YearValue Mod 4 = 0) Then
            If DayValue > 29 Then Ok = False
          Else
            If DayValue > 28 Then Ok = False
          End If
        Case Else
          Ok = False
      End Select
    End If
  End If
 
  If Ok Then
    StringToDate = DateSerial(YearValue, MonthValue, DayValue)
  Else
    StringToDate = 0
  End If
End Function

Dans ce code, la fonction StringToDate convertit un string au format dd/mm/yyyy (ou dd-mm-yyyy) en une date. Si la chaine ne peut être convertie en date, StringToDate renvoie 0.

Les deux valeurs saisies dans GetPeriodDates sont transformées par StringToDate et GetPeriodDates renvoie un tableau(0 to1) si tout est ok, sinon elle renvoie 0.

La fonction qui souhaite filtrer va tester que getPeriodDates renvoie bien un array pour filtrer, sinon elle affiche une erreur.

[Passepartout007]

Bonjour,

Voici donc le code final :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Option Explicit
 
 
 
Sub FilterTable()
  Dim Dates
  Dim BeginDate As Date
  Dim EndDate As Date
  Dim tmp As Date
 
  Dates = getPeriodDates()
  If IsArray(Dates) Then
    BeginDate = Dates(0)
    EndDate = Dates(1)
    If BeginDate > EndDate Then tmp = BeginDate: BeginDate = EndDate: EndDate = tmp
    Range("tableau1").AutoFilter field:=2, Criteria1:=">=" & CLng(BeginDate), Criteria2:="<=" & CLng(EndDate)
  Else
    MsgBox "Dates non valides"
  End If
 
End Sub
 
 
 
Function getPeriodDates()
  Dim Ok As Boolean
  Dim RetValue(0 To 1)
  Dim strDate1 As String
  Dim strDate2 As String
 
  strDate1 = InputBox("Veuillez saisir la date de début au format jj/mm/yyyy")
  strDate2 = InputBox("Veuillez saisir la date de fin au format jj/mm/yyyy")
  RetValue(0) = StringToDate(strDate1)
  RetValue(1) = StringToDate(strDate2)
  If RetValue(0) > 0 And RetValue(1) > 0 Then
    getPeriodDates = RetValue
  Else
    getPeriodDates = 0
  End If
End Function
 
Function StringToDate(Value As String) As Date
  Dim Ok As Boolean
  Dim YearValue As Long
  Dim MonthValue As Long
  Dim DayValue As Long
 
  Ok = True
  If Not Value Like "##/##/####" And Not Value Like "##-##-####" Then
    Ok = False
  Else
    YearValue = Right(Value, 4) * 1
    MonthValue = Mid(Value, 4, 2) * 1
    DayValue = Left(Value, 2) * 1
    If YearValue < 1900 Then
      Ok = False
    Else
      Select Case MonthValue
        Case 1, 3, 5, 7, 8, 10, 12
          If DayValue > 31 Then Ok = False
        Case 4, 6, 9, 11
          If DayValue > 30 Then Ok = False
        Case 2
          If YearValue Mod 400 = 0 Or (YearValue Mod 100 <> 0 And YearValue Mod 4 = 0) Then
            If DayValue > 29 Then Ok = False
          Else
            If DayValue > 28 Then Ok = False
          End If
        Case Else
          Ok = False
      End Select
    End If
  End If
 
  If Ok Then
    StringToDate = DateSerial(YearValue, MonthValue, DayValue)
  Else
    StringToDate = 0
  End If
End Function

Merci à tout le monde pour sont aide, et surtout à Pierre Fauconnier.
Cordialement,
Passepartout007