Discussion :

[zealot37]

Bonjour à tous,

j'ai une procédure pour laquelle j'aimerais mettre un controle en place :
La procédure comprare deux dates (format jj/mm/aaaa) par rapport à la date du jour

Code :

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

If (datedeb <= Date And datefin >= Date) Then

pour faire un copier coller sur une autre feuille.

J'aimerais controler que le jour de datedeb est le premier jour du mois (pas le mois en cours, n'importe quel mois) et que le jour de datefin est le 30 (ou le 28 pour février), mais je ne vois pas comment faire... ?

Quelqu'un peut-il m'apporter son aide ?

Merci

[mercatog]

Une fonction booléenne personnalisée qui permet de tester si aujourd'hui est entre la date de début et la date de fin et que la date de début est le premier jour du mois et la date de fin est le dernier jour du mois

Code :

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

1
2
3
4
Function MonTest(ByVal DteDeb As Date, DteFin As Date) As Boolean
 
MonTest = Day(DteDeb) = 1 And Month(DteFin + 1) <> Month(DteFin) And DteDeb <= Date And DteFin >= Date
End Function

[zealot37]

Merci Mercatog,

comment puis-je inserer la fonction dans ma procedure ou remplacer ce qui devient inutile ?

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
Dim derlig As Long
Dim Plage As Range, cel As Range
 
 
derlig = Range("A65536").End(xlUp).Row
Set Plage = Range("A10:A" & derlig)
 
Range("F10").Select
For Each cel In Plage
    If IsEmpty(ActiveCell) Then
        ActiveCell.Offset(1, 0).Select
            Else
                If CDate(ActiveCell) > CDate(ActiveCell.Offset(0, -1)) Or CDate (ActiveCell) = CDate(ActiveCell.Offset(0, -1)) Then
                    ActiveCell.Offset(1, 0).Select
                            Else
                            If CDate(ActiveCell) = CDate(ActiveCell.Offset(0, -1)) Then                                    
                                  ActiveCell.Offset(1, 0).Select
                                    Else: Exit Sub
                          End If
                    End If
    End If
Next cel

sachant que colonne F => dateFin
colonne E => dateDeb
et que pour certaine ligne j'utilise =aujourdhui à la place de dateDeb et DateFin d'ou

Code :

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

CDate (ActiveCell) = CDate(ActiveCell.Offset(0, -1))

[mercatog]

Tu veux comparer quoi au juste?
Si DteDeb est le premier du mois X (colonne E) et DteFin le dernier jour du mois X (colonne F)?

[zealot37]

Je veux controle que DateDeb est le premier du mois X (colonne E) et DateFin le dernier jour du mois X (colonne F) et que dateFin > DateDeb (sauf pour les lignes ou j'utilise =aujourdhui)

d'ou ma question d'inserer la fonction dans ma procédure existante, mais j'ai un peu de mal à utiliser des fonction perso

[mercatog]

Exemple on colorie les cellules de E et F répondant aux critères de comparaison explique dans la fonction MonTest

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
Sub Test()
Dim DerLig As Long
Dim Plage As Range, Cel As Range
 
With Worksheets("Feuil1") 'A adapter
    DerLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set Plage = Range("E10:E" & DerLig)
    For Each Cel In Plage
        If IsDate(Cel) And IsDate(Cel.Offset(0, 1)) Then
            If MonTest(Cel, Cel.Offset(0, 1)) Then
                Cel.Resize(1, 2).Interior.ColorIndex = 28
            End If
        End If
    Next Cel
End With
End Sub
 
Private Function MonTest(ByVal DteDeb As Date, DteFin As Date) As Boolean
Dim S As Boolean
 
'Compare si DteDeb < DteFin
S = DteDeb < DteFin
'Compare si dteDeb est le début du mois et DteFin est le dernier jour du mois
S = S And Day(DteDeb) = 1 And Month(DteFin + 1) <> Month(DteFin)
'Compare si DteDeb ou DteFin n'est pas aujourdhui
S = S And DteDeb <> Date And DteFin <> Date
'Compare si DteDeb apprtiennent au même mois
S = S And Month(DteDeb) = Month(DteFin)
'Compare si DteDeb apprtiennent à la même année
S = S And Year(DteDeb) = Year(DteFin)
'Résultat des différentes comparaisons
MonTest = S
End Function