Différence entre une date donnée et la date du jour

[Fab]

Salut,
La macro que j'essaie de faire à pour but de comparer toutes les dates données dans une colonne avec la date du jour. Si la différence (nb de jour) est inférieure à 4 ou négative, il y aura une action qui suivra. Sinon, il doit passer à la date suivante.

Voici le code que j'ai tapé et qui ne fonctionne pas (je soupconne que le format des variables choisi pour les dates est faux).

Sub DeterminationActionDelaLimite()
Dim Cejour As Date
Dim DateLimite As String
Dim DelaiLimite
Dim i
Dim DateActuelle As String
Dim Blanc

Cejour = Now
DateActuelle = Format(Cejour, "dddd dd mmm yyyy")

' Vérification sur la feuille
Sheets("Process OM-174-DP").Select

i = 3
' Début de la boucle
For i = 8 To 200
' Transfert heure d'arrivée dans cellule
Range("F" & i).Select
If Range("F" & i) = "" Then
Blanc = 0
Else
Range("F" & i).Value = DateLimite
DelaiLimite = (DateLimite - DateActuelle)
If DelaiLimite < 4 Then
' Action
ActiveCell.Value = "Raté"
Else
Blanc = 0
End If
End If
Next i
End Sub

Merci d'avance et bonne journée.
Fab

 

[Michel_M]

Bonjour,

Difficille de répondre sans libellé de l'erreur et indication de la ligne de plantage

néanmoins

DelaiLimite = (DateLimite - DateActuelle)
est la soustraction de 2 variables string

Michel

 

[Pascal76]

Salut

A vue de nez vite fait sans tester

Sub DeterminationActionDelaLimite()
Dim Cejour As Date
Dim DateLimite As Date '<<Modif ici
Dim DelaiLimite
Dim i
Dim DateActuelle As Date '<<Modif ici
Dim Blanc

Cejour = Now
DateActuelle = Format(Cejour, "dddd dd mmm yyyy")

' Vérification sur la feuille
Sheets("Process OM-174-DP").Select

i = 3
' Début de la boucle
For i = 8 To 200
' Transfert heure d'arrivée dans cellule
Range("F" & i).Select
If Range("F" & i) = "" Then
Blanc = 0
Else
DateLimite = Range("F" & i).Value ' << Modif ici
'ou DateLimite = cDate(Range("F" & i).Value) ' a voir si la ligne audessus ne marche pas
DelaiLimite = (DateLimite - DateActuelle)
If DelaiLimite < 4 Then
' Action
ActiveCell.Value = "Raté"
Else
Blanc = 0
End If
End If
Next i
End Sub

Bon courage

Pascal

 

[Fab]

Super,
Merci ça marche parfaitement.
Bonne fin de journée