Optimiser la saisie de la date et heure (VBA)

Question

J'aimerais optimiser la saisie de la date et de l'heure grâce à du VBA. Je m'explique... J'ai un grand tableau de donnée dans lequel l'utilisateur rentre des données dont la date, l'heure de début et l'heure de fin (une colonne par type de donnée). Il s'agit de rendez-vous. Je recherche à automatiser la saisie de manière à ce que lorsque l'utilisateur rentre par exemple 0800, Excel retranscrive ceci en 08:00 J'ai déjà un code qui fonctionne (ci-après) pour un userform avec des textbox mais je n'arrive pas à le retranscrire et l'adapter dans la feuille. Est-ce qu'une âme charitable viendrait à mon secours ?? Voici le code mentionnée : Date : Private Sub TextBox1_AfterUpdate() Dim b As String b = Len(Me.TextBox1) If b = 4 Then Me.TextBox1 = Left(Me.TextBox1, 2) & "/" & Right(Me.TextBox1, 2) & ANNEE ElseIf b = 6 Then Me.TextBox1 = Left(Me.TextBox1, 2) & "/" & Mid(Me.TextBox1, 3, 2) & "/" & Right(Me.TextBox1, 2) ElseIf b = 8 Then Me.TextBox1 = Left(Me.TextBox1, 2) & "/" & Mid(Me.TextBox1, 3, 2) & "/" & Right(Me.TextBox1, 4) End If On Error Resume Next Me.TextBox1 = Format(Me.TextBox1, "dd/mm/yyyy") End Sub Heure : Private Sub TextBox2_AfterUpdate() Dim a As String a = Len(Me.TextBox2) If a &lt;= 2 Then &nbsp;&nbsp;&nbsp;&nbsp;On Error Resume Next &nbsp;&nbsp;&nbsp;&nbsp;Me.TextBox2 = Left(Me.TextBox2, a) & ":" & 0 ElseIf a = 3 Then &nbsp;&nbsp;&nbsp;&nbsp;Me.TextBox2 = Left(Me.TextBox2, 1) & ":" & Right(Me.TextBox2, 2) Else &nbsp;&nbsp;&nbsp;&nbsp;Me.TextBox2 = Left(Me.TextBox2, 2) & ":" & Right(Me.TextBox2, 2) End If &nbsp;&nbsp;&nbsp;&nbsp;Me.TextBox2 = Format(Me.TextBox2, "hh:mm") End Sub...

Steelson · Accepted Answer

OK pour les heures, si tu es sûr de ne pas avoir besoin de saisir une heure entre minuit et 00:59, on peut modifier (ce qui interdit aussi 24)

If Not Intersect(Target, Columns("B")) Is Nothing Then
    If IsNumeric(Target) And Target >= 1 Then
        If Target >= 100 Then
            txt = Right("0000" & CStr(Target), 4)
            Target = Mid(txt, 1, 2) / 24 + Mid(txt, 3, 2) / 24 / 60
        Else
            txt = Right("00" & CStr(Target), 2) & "00"
            Target = Mid(txt, 1, 2) / 24 + Mid(txt, 3, 2) / 24 / 60
        End If
    End If
End If

En revanche pour les dates (à noter que tu peux aussi saisir 5 chiffres 10121 ou 7 chiffres 1012021 pour le 1/1/2021 = mais ce n'est pas cela le problème), on ne pourrait pas revenir sur une date qui serait alors déjà passée en numérique. J'avais fait des essais de re-saisie et cela devenait inextricable. C'est pourquoi saisir 4 chiffres pour l'année permettait de bien différentier.

La solution -que je n'ai pas encore réussie à mettre en œuvre- c'est d'ouvrir un textbox lors de la sélection de la zone

Steelson · Accepted Answer

Ce n'est pas possible. On ne peut pas tout avoir, excel a des limites aussi, mais je peux essayer de n'appliquer le code que sur des cellules vierges...

Steelson · Answer

Une solution équivalente, sans doute à affiner ... edit : légère modification ci-dessous...

Steelson · Answer

Pour la date, si en effet tu ne saisis que 2 chiffres pour l'année, il faudrait alors modifier. Mais il y a un problème de décision quand la date est par exemple 41221 qui pourrait être 4/12/2021 ou 8/11/2012 qui correspond au nombre 41221. Donc pour pouvoir décider, il faut mettre l'année à 4 chiffres, ou passer la colonne A en texte ce qui interdit ensuite de l'utiliser comme date.

Et pour l'heure je pourrais adapter, mais dans ce cas on ne pourra pas saisir 0h10 car je ne pourrai pas faire de différence entre 10h et 10mn. Il faut donc mettre 00 pour les minutes.

J'ai modifié, mais je ne vois pas personnellement d'autres solutions que de mettre l'année à 4 chiffres et les minutes a minima à 00.

68date-heure.xlsm (16.31 Ko)

Steelson · Answer

Bon, j'ai réussi.

Une variante à partir de laquelle on pourrait travailler ...

21date-heure.xlsm (25.41 Ko)

quoique en l'état cela me plait beaucoup, elle reste pure au sens où la cellule reste en format date et la saisie se fait ne mode texte comme tu le préconisait ... la seule amélioration est de saisir les 2 premiers chiffres de l'année (20xx)

Le code pour la date en colonne A

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub
    If Target.Row = 1 Then Exit Sub

    If Not Intersect(Target, Columns("A")) Is Nothing Then
        With Me.DateBox1
            .Height = Target.Height + 4
            .Width = Target.Width
            .Top = Target.Top - 2
            .Left = Target.Left
            .Value = Target
            .Visible = True
            .Activate
        End With
    Else
        Me.DateBox1.Visible = False
    End If

End Sub

Private Sub DateBox1_KeyPress(ByVal KeyCode As MSForms.ReturnInteger)
    If DateBox1 = "" Then DateBox1 = "__/__/____": DateBox1.SelStart = 0
    If InStr("0123456789", Chr(KeyCode)) = 0 Then KeyCode = 0
    DateBox1.BackColor = vbWhite
    x = Replace(Replace(DateBox1, "_", ""), "/", "") & Chr(KeyCode)
    Select Case True
        Case Len(x) <= 2
            y = Len(x) + IIf(Len(x) = 2, 1, 0)
            x = Left(x & "__", 2) & "/__/____"
        Case Len(x) > 2 And Len(x) <= 4
            y = Len(x) + 1 + IIf(Len(x) = 4, 1, 0)
            x = Mid(x, 1, 2) & "/" & Left(Mid(x, 3, 2) & "__", 2) & "/____"
        Case Len(x) > 4
            y = Len(x) + 2
            x = Mid(x, 1, 2) & "/" & Mid(x, 3, 2) & "/" & Left(Mid(x, 5, 4) & "____", 4)
    End Select
    DateBox1 = x: DateBox1.SelStart = y: t = Split(Replace(x, "_", ""), "/"): KeyCode = 0
    If t(0) > 31 Then DateBox1.BackColor = RGB(255, 128, 128)
    If t(1) <> "" And t(1) > 12 Then DateBox1.BackColor = RGB(255, 128, 128)
    If t(1) <> "" And t(1) <> 0 Then If Not IsDate(t(0) & "/" & t(1) & "/" & "2000") Then DateBox1.BackColor = RGB(255, 128, 128)
    If t(1) <> "" And t(1) <> 0 And Len(t(2)) = 4 Then If Not IsDate(t(0) & "/" & t(1) & "/" & t(2)) Then DateBox1.BackColor = RGB(255, 128, 128)
End Sub

Private Sub DateBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        ActiveCell = CDate(DateBox1.Value)
        ActiveCell.Offset(0, 1).Select
    End If
End Sub

Steelson · Answer

Je ferai demain matin la version strictement conforme à ton cahier des charges...