Affichage date en fonction heure VBA

Bonjour,

Je fais appel à vous car je rencontre un problème pour afficher une date en fonction de l'heure à laquelle une cellule est remplie.

Je m'explique, j'ai une macro qui se lance par double clique et qui affiche le Username en colonne E. Ensuite une macro récupère l'heure de saisie et affiche la date correspondante en colonne D et B.

La contrainte est que je voudrais que si la saisie est réalisée entre minuit et 5h du matin, la date affichée soit celle de la veille et non celle du jour.

Voici le code que j'utilise, le code affiche bien les dates mais sans tenir compte de l'heure. Il y a sans doute une erreur au niveau du " IF Time " mais je ne sais ni où ni comment la corriger.

Merci d'avance à ceux qui jeteront un oeil à mon problème

[Code]

Private Sub Worksheet_Change(ByVal Target As Range)

Dim c, Infini As Range

On Error GoTo Ereur

Set Infini = Intersect(Target, Range("e:e"))

If Infini Is Nothing Then Exit Sub

Application.EnableEvents = False

For Each c In Infini.Cells

If IsEmpty(c) Then

c.Offset(0, -1) = ""

c.Offset(0, -3) = ""

Else

If Time >= "23:59:59" And Time <= "05:00:00" Then

c.Offset(0, -1) = Format(Now - 1, "mm/dd/yyyy")

c.Offset(0, -3) = Format(Now - 1, "dd/mm/yyyy - hh")

Else

c.Offset(0, -3) = Format(Now, "dd/mm/yyyy - hh")

c.Offset(0, -1) = Format(Now, "mm/dd/yyyy")

End If

End If

Next

Ereur:

Application.EnableEvents = True

End Sub

12apc-test-2018.xlsm (147.78 Ko)

Bonjour,

de mon coté cela fonctionne en testant le Time par rapport à une décimale, car sous VBA l'heure est une décimale d'un jour, donc 5 heures = 0.208333333333333 d'une journée.

Dans votre cas il faut juste connaitre les décimales des heures de test, ou bien transformer la valeur alphanumérique "05:00:00" en format comparable à Time ou bien Time comparable à "05:00:00" :

Format(Time,"hh:mm:ss")

@ bientôt

LouReeD

Bonjour,

En effet cela fonctionne aussi pour moi ! Quand je double clique sur une cellule vide de la colonne, cela m'affiche bien le User, ainsi que les dates correspondantes. Par contre quand je clique sur une cellule deja remplie de la colonne, cela se met à jour et modifie les dates précédemment saisies.

Une idée pour ne pas appliquer la macro aux lignes dont la colonne E est déjà remplie svp ?

Voici les deux codes que j'ai combinés (Double clique pour faire apparaître le User + Dates de saisies).

Merci beaucoup de votre aide !

[Code]

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

If Target = "" Then

With Target

If .Column = 5 Then .Value = Environ("Username"): Cancel = True

End With

End If

Dim c, Infini As Range

On Error GoTo Ereur

Set Infini = Intersect(Target, Range("e:e"))

If Infini Is Nothing Then Exit Sub

Application.EnableEvents = False

For Each c In Infini.Cells

If IsEmpty(c) Then

c.Offset(0, -1) = ""

c.Offset(0, -2) = ""

Else

If Time >= "00:00:00" And Time <= "05:00:00" Then

c.Offset(0, -1) = Format(Now - 1, "mm/dd/yyyy")

c.Offset(0, -2) = Format(Now - 1, "dd/mm/yyyy - hh")

Else

c.Offset(0, -2) = Format(Now, "dd/mm/yyyy - hh")

c.Offset(0, -1) = Format(Now, "mm/dd/yyyy")

End If

End If

Next

Ereur:

Application.EnableEvents = True

End Sub

Bonjour,

voici une proposition de code avec un peu de commentaire :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' test si le double clic à lieu sur la colonne E
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
        If Target.Row < 3 Then Exit Sub ' si double clic sur une ligne d'entête ou au dessus alors on quitte la procédure
        Cancel = True ' on annule l'entrée dans la cellule
        ' maintenant on a double cliquer sur une des cellules de la colonne E
        If Target.Value <> "" Then Exit Sub ' si il y a déjà une valeur en colonne E alors on quitte la procédure
        ' maintenant on a double cliquer sur une des cellules de la colonne E
        ' et la cellule colonne E est vide
        If Time >= "00:00:00" And Time <= "05:00:00" Then
            Target.Offset(0, -1) = Format(Now - 1, "mm/dd/yyyy")
            Target.Offset(0, -3) = Format(Now - 1, "dd/mm/yyyy - hh")
        Else
            Target.Offset(0, -3) = Format(Now, "dd/mm/yyyy - hh")
            Target.Offset(0, -1) = Format(Now, "mm/dd/yyyy")
        End If
        Target.Value = Environ("Username")
    End If
End Sub

A noter que j'utilise le double clic de la feuille :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

et non pas :

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

@ bientôt

LouReeD

Rechercher des sujets similaires à "affichage date fonction heure vba"