Macro d'antidatage

Bonjour à vous,

Je dois réaliser pour le boulot la macro suivante : un gars doit remplir un tableau Excel avec les références du matériel et ses dates d'arrivée et de futur départ à la casse, et ce chaque mois. Vu que ces compétences sur cet outil sont douteuses, on doit faire en sorte de lui faciliter le boulot.

Chaque matos possède une date d'arrivée sur site mais pas forcément de date de départ (il y a donc parfois en fin de tableau sur la même colonne "Date départ" des cases vides), et le but de la macro est qu'à chaque modification d'une case du Range correspondant aux cases vides on doit vérifier que la date de départ entrée par le gars est inférieure à la date actuelle, il ne doit pas avoir d'antidatage. Ce Range étant variable chaque mois, on doit ajuster ses dimensions.

J'ai réussi cette dernière partie, mais pas la fonction d'antidatage qui me résiste depuis pas mal de jours.

Voici ce que j'ai fait pour l'instant mais qui ne marche visiblement pas :

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
    Dim cpt As Integer

    DateNow = Format(Date, "dd/mm/yyyy")
    LastCell_B = Range("B100").End(xlUp).Row            
    LastCell_F = Range("F100").End(xlUp).Offset(1, 0).Row

'C'est à partir d'ici que tout se complique
    Set KeyCells = Range(Cells(LastCell_F, 6), Cells(LastCell_B, 6))
    If Not Application.Intersect(KeyCells, Range(Target.Address)) 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.Address.ClearContents
        End If
    End If

End Sub

J'implore votre aide

Mathias

Bonjour

La date de départ est en colonne F ?

Le but étant bien que F soit toujours supérieur à B ?

A te relire

Edit Dan: la date de départ n'est pas toujours sur la ligne de la date d'arrivée ??

Salut et merci de ta réponse,

Exactement les dates de départ sont en colonne F.

LastCell_F va me permettre de sélectionner la case en dessous de la dernière case remplie de la colonne F.

Ensuite je sais que la colonne B sera toujours remplie au maximum, je me sers donc de ça pour sélectionner la dernière ligne remplie depuis B100 (c'est à dire la dernière ligne du tableau). Je me sers donc ensuite de ces deux paramètres pour set mon range KeyCells.

Donc LastCell_B > LastCell_F

P.S : LastCell_B ne se situe pas à la flèche mais va permettre de localiser la fin du range sur cette case.

Re,

Au vu de ton fichier je ne vois pas pourquoi tu t'occupes de la colonne B

Ce que tu cherches à faire, c'est bien de controler que la date entrée en colonne F est inférieur à la date d'aujourd'hui

Si oui, pourquoi tu me parles de LastCell_B > LastCell_F ?

Merci de tes précisions

Oui bien sûr mais le Range est variable de feuille en feuille !

Il faut constamment qu'il change, je dois donc prendre une colonne que je sais toujours remplie au maximum (en l’occurrence la colonne B) pour délimiter la fin du Range. Mais ça c'est pas trop le soucis le Range est bon, ce qui me taraude le plus c'est le fait de récupérer dès modification dans une des cellules du Range le contenu de l'adresse de la Target et de la comparer à la date d'aujourd'hui.

Re

Si tu veux uniquement controler la date que tu changes en colonne F essaie en remplaçant tout le code par celui-ci

Dim ok As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastCell_B As Integer
Dim DateCell As Date, DateNow As Date

If ok Then Exit Sub
DateNow = Format(Date, "dd/mm/yyyy")
LastCell_B = Range("B100").End(xlUp).Row

If Not Application.Intersect(Target, Range("F8:F" & LastCell_B)) Is Nothing Then
    DateCell = Format(Target, "dd/mm/yyyy")
    If DateCell < DateNow Then
        MsgBox ("Attention la date entrée est inférieure à la date d'aujourd'hui")
        ok = True
        Target.ClearContents
    End If
End If
ok = False
End Sub

Si ok, clique sur le v vert à coté du bouton EDITER pour cloturer le fil

Amicalement

Merci de ton aide et de ta patience Dan

Mathias

Rechercher des sujets similaires à "macro antidatage"