Discussion :

[Invité]

Bonjour à tous,

Je suis depuis plusieurs jours confronté à un problème : je dois créer une macro Excel qui va permettre lors d'une modification de cellule dans un Range donné - Range qui doit contenir des dates - de vérifier si la date inscrite dans la cellule est bien supérieure à la date d'aujourd'hui. Si ce n'est pas le cas on avertit l'utilisateur de son erreur et on supprime le contenu de la cellule (ou du Range ça revient au même)
Voici ce que j'ai fait pour l'instant mais que ne marche pas :

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim KeyCells As Range
    Dim LastCell_B As Integer
    Dim LastCell_F As Integer
    Dim DateCell As Date
    Dim DateNow As Date
 
    DateNow = Format(Date, "dd/mm/yyyy")
    LastCell_B = Range("B100").End(xlUp).Row                
    LastCell_F = Range("F100").End(xlUp).Offset(1, 0).Row
 
    Set KeyCells = Range(Cells(LastCell_F, 6), Cells(LastCell_B, 6))
    If Not Intersect(Target, KeyCells) Is Nothing Then
        DateCell = Format(Target.Address, "dd/mm/yyyy")
        If DateCell < DateNow Then
            MsgBox ("Attention la date entrée est inférieure à la date d'aujourd'hui")
            Target.ClearContents
        End If
    End If
 
End Sub

KeyCells donne la bonne sélection de cellule, j'ai vérifié mais c'est avec le Target et stocker son adress sous forme de date que j'ai du mal...
J'implore votre aide
Mathias

[EngueEngue]

En changeant tes formats(date,...) par des Cdate(range) devrait gazer

[Invité]

C'est à dire ? J'ai googlé un peu la fonction Cdate mais je vois pas trop comment elle pourrait servir...

[EngueEngue]

Ton code est bon, sauf que donner des formats à des dates à traiter ne sert à rien. Convertit les en dates et traite les direct.

[Invité]

Voici ce que j'ai fait en suivant ta méthode :

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim KeyCells As Range
    Dim LastCell_B As Integer
    Dim LastCell_F As Integer
    Dim DateCell As String
    Dim DateNow As String
 
    DateNow = "27/08/2013"
    LastCell_B = Range("B100").End(xlUp).Row
    LastCell_F = Range("F100").End(xlUp).Offset(1, 0).Row
 
    Set KeyCells = Range(Cells(LastCell_F, 6), Cells(LastCell_B, 6))
    If Not Intersect(Target, KeyCells) Is Nothing Then
        DateCell = Target.Address
        If CDate(DateCell) < CDate(DateNow) Then
            MsgBox ("Attention la date entrée est inférieure à la date d'aujourd'hui")
            Target.ClearContents
        End If
    End If
 
End Sub

Cela ne marche pas, il me sort une erreur d’incompatibilité de type.

[EngueEngue]

Tu fais n'importe quoi...

Par contre pas compris pourquoi keycells n'est que sur la colonne F alors que tu utilises la derniere ligne de B aussi... Mais bon:

Voilà elle marche

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim KeyCells As Range
    Dim LastCell_B As Integer
    Dim LastCell_F As Integer
    Dim DateCell As Date
 
 
 
    LastCell_B = Range("B100").End(xlUp).Row
    LastCell_F = Range("F100").End(xlUp).Offset(1, 0).Row
 
    Set KeyCells = Range(Cells(LastCell_F, 6), Cells(LastCell_B, 6))
    If Not Intersect(Target, KeyCells) Is Nothing Then
 
        If CDate(Target) < Date Then
            MsgBox ("Attention la date entrée est inférieure à la date d'aujourd'hui")
            Application.EnableEvents = False
            Target.ClearContents
 
        End If
    End If
 Application.EnableEvents = True
End Sub

Petit rafinage:

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim KeyCells As Range
    Dim LastCell_B As Integer
    Dim LastCell_F As Integer
    Dim DateCell As Date
 
 
 
    LastCell_B = Range("B100").End(xlUp).Row
    LastCell_F = Range("F100").End(xlUp).Offset(1, 0).Row
 
    Set KeyCells = Range(Cells(LastCell_F, 6), Cells(LastCell_B, 6))
    If Not Intersect(Target, KeyCells) Is Nothing Then
        If IsDate(Target) = False Then
            MsgBox ("Attention vous n'avez pas rentré une date")
            Application.EnableEvents = False
            Target.ClearContents
            Application.EnableEvents = True
            Exit Sub
        Else
            If Target < Date Then
                MsgBox ("Attention la date entrée est inférieure à la date d'aujourd'hui")
                Application.EnableEvents = False
                Target.ClearContents
            End If
        End If
    End If
 Application.EnableEvents = True
End Sub