code pour saisie heures 1000 =10h00 avec un range

[Regueiro]

Bonsoir le Forum
Ce code me permets de saisir des heures rapidement.
Par exemple :
1000 = 10h00
0015 = 00h15
J'aimerais le restreindre à plusieurs zone de ma feuille.
Par exemple F11:K18 et M11:R18
Voici le code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Compteur As Integer
'Dim cell As Range 'xxxxxxxx
    Application.ScreenUpdating = False
    Application.EnableEvents = False


If Target.Count = 1 And IsNumeric(Target.Value) Then
   'For Each cell In Range("F11:K18") 'xxxxxxx

    If InStr(1, Target.Value, ":", 1) = 0 And Not (Target.Value = "") Then
        Compteur = InStr(1, Target.NumberFormat, ":", 1)
        If Compteur > 0 And Target.Value = (Target.Value \ 1) Then
            Compteur = InStr(Compteur + 1, Target.NumberFormat, ":", 1)
            If Compteur > 0 Then
                Select Case Len(Target.Value)
                    Case Is < 3
                        Target.Value = TimeSerial(0, 0, Target.Value)
                    Case Is < 5
                        Target.Value = TimeSerial(0, Left(Right(Target.Value, 4), 2), Right(Target.Value, 2))
                    Case Else
                        Target.Value = TimeSerial(Left(Target.Value, Len(Target.Value) - 4), Left(Right(Target.Value, 4), 2), Right(Target.Value, 2))
                End Select
            Else
                Select Case Len(Target.Value)
                    Case Is < 3
                        Target.Value = TimeSerial(0, Target.Value, 0)
                    Case Else
                        Target.Value = TimeSerial(Left(Target.Value, Len(Target.Value) - 2), Right(Target.Value, 2), 0)
                End Select
            End If
        End If
    End If
    Next    'xxxxxxxx
'End If
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

Merci de votre Aide.
A+

 

[Grand Chaman Excel]

Re : code pour saisie heures 1000 =10h00 avec un range

Bonjour Regueiro,

Au lieu d'une macro, tu pourrais utiliser un format de nombre personnalisé ?

00"H"00

Et, au besoin, ajouter une validation sur ces cellules afin de vérifier que le nombre de caractères entré est de 4.

A+

 

[Victor21]

Re : code pour saisie heures 1000 =10h00 avec un range

Bonsoir, Regueiro, GCE

Pour ma part, j'utilise le correcteur orthographique pour saisir les heures (Outils, Options, Orthographe, Options de correction automatique, Remplacer ".." par ":" - sans les guillemets )
Et pour 10:00, je saisis sur le pavé numérique 10..
pour 10:05, je saisis 10..05
Et ça ne change pas la valeur saisie !

 

[Gareth]

Re : code pour saisie heures 1000 =10h00 avec un range

Bonsoir,

Dans le fichier joint un exemple qui applique les modifications sur les zones demandées.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Set Var = Application.Intersect(Target, Range("F11:K18,M11:R18"))
If Target.Columns.Count = 1 And Target.Rows.Count = 1 Then
    If Not Var Is Nothing And IsNumeric(Target.Value) Then
        Target.Value = Left(Format(Target, "0000"), 2) & ":" & Right(Format(Target, "0000"), 2)
    End If
End If
Application.EnableEvents = True
End Sub

 

[Regueiro]

Re : code pour saisie heures 1000 =10h00 avec un range

Bonsoir merci pour vos réponses.
Mais ?
Je saisie en A1 1000 = 10:00 OK Format person = 00":"00
en A2 1215 = 12:15 OK
en A3 = A2-A1 = 02:15 = 2 heures et 15 minutes
En A4 = 60.00 de l'heure
En A5 = (A3 x A4)/100 = 129.00 au lieu de 135.00
Merci de votre aide

 

[Victor21]

Re : code pour saisie heures 1000 =10h00 avec un range

Re,

La modification d'un format n'a aucune incidence sur la valeur saisie.
En réalité, vous effectuez l'opération (1215-1000)*60/100, ce qui fait bien 129.00

 

[Gareth]

Re : code pour saisie heures 1000 =10h00 avec un range

Bonsoir,

Mets cette formule en A5 : =A3/"1:00"*A4

Pourquoi tu divises par 100 ?

 

[Regueiro]

Re : code pour saisie heures 1000 =10h00 avec un range

Merci Gareth.
C'est exactement ce que je cherchais.
A+

 

[Regueiro]

Re : code pour saisie heures 1000 =10h00 avec un range

voilà mon fichier.
Je suis encore en pleine amélioration.
Bonne soirée