Macro VBA d'antidatage

Version imprimable

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:

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 :cry:
Mathias

27/08/2013, 09h19
EngueEngue

En changeant tes formats(date,...) par des Cdate(range) devrait gazer
27/08/2013, 09h35
Invité

C'est à dire ? J'ai googlé un peu la fonction Cdate mais je vois pas trop comment elle pourrait servir...
27/08/2013, 09h39
EngueEngue

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

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

Code:

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.

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:

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:

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

27/08/2013, 10h14
Invité

Nan mais ça c'est mon petit système de derrière les fagots faut pas chercher :-)
Rolala puis en plus tu te donnes la peine de l'améliorer :kiss:

Vraiment merci beaucoup de ton aide !
Mathias