XL 2010 Insérer des heures rapidement (4 chiffres sans ":")

tchi456

XLDnaute Occasionnel
Bonjour,

J'ai un tableur Excel avec des additions et des soustractions d'heures et j'aimerais que dans certaines cellules je puisse écrire des heures en 4 chiffres sans ":" entre les heures et les minutes.

Exemple: j'aimerai écrire 0730 et que ça me note 07:30:00 dans la cellule.

Avez-vous une astuce?

Meilleures salutations,

Thierry
 

Pièces jointes

  • Heures.xlsx
    59.2 KB · Affichages: 11
Solution
Bonjour tchi456, sylvanu, Modeste geedee,

Voyez le fichier .xlsm joint et cette macro dans le code de la feuille "Heures" :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, UsedRange)
If Target Is Nothing Then Exit Sub
Dim x$
Application.EnableEvents = False 'désactive les évènements
For Each Target In Target 'si entrées multiples
    If CStr(Target) Like "###" Or CStr(Target) Like "####" Then
        x = Format(Target, "0000")
        If Left(x, 2) < "24" And Right(x, 2) < "60" Then Target = Left(x, 2) & ":" & Right(x, 2)
    End If
Next
Application.EnableEvents = True 'réactive les évènements
End Sub
Les heures peuvent être entrées n'importe où sous la forme 815 pour 08:15 ou 2359 pour...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Tchi,
Mettez en format personnalisé : hhmm

1633619399395.png
 

job75

XLDnaute Barbatruc
Bonjour tchi456, sylvanu, Modeste geedee,

Voyez le fichier .xlsm joint et cette macro dans le code de la feuille "Heures" :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, UsedRange)
If Target Is Nothing Then Exit Sub
Dim x$
Application.EnableEvents = False 'désactive les évènements
For Each Target In Target 'si entrées multiples
    If CStr(Target) Like "###" Or CStr(Target) Like "####" Then
        x = Format(Target, "0000")
        If Left(x, 2) < "24" And Right(x, 2) < "60" Then Target = Left(x, 2) & ":" & Right(x, 2)
    End If
Next
Application.EnableEvents = True 'réactive les évènements
End Sub
Les heures peuvent être entrées n'importe où sous la forme 815 pour 08:15 ou 2359 pour 23:59.

A+
 

Pièces jointes

  • Heures(1).xlsm
    66.4 KB · Affichages: 25

tchi456

XLDnaute Occasionnel
Bonjour à tous,

Je vous remercie pour votre aide.
Le code de job75 fonctionne parfaitement.
Celui-ci est aussi possible:

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
    If Not Intersect([C2:C225,H2:H225,J2:J225,L2:L225,N2:N225], Target) Is Nothing And Target.Count = 1 Then
        Application.EnableEvents = False
            If Target <> 0 Then
                If InStr(Target.Text, ":") = 0 Then
                    Temp = Format(Target, "0000")
                    Temp = Left(Temp, 2) & ":" & Right(Temp, 2) & ""
                        If IsDate(Temp) Then
                            Target = Temp
                        End If
                End If
            End If
        Application.EnableEvents = True
    End If
End Sub

Meilleures salutations et bon week-end!

Thierry
 

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff

tchi456

XLDnaute Occasionnel
Bonjour à tous,

Je vous remercie pour votre aide.
Le code de job75 fonctionne parfaitement.
Celui-ci est aussi possible:

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
    If Not Intersect([C2:C225,H2:H225,J2:J225,L2:L225,N2:N225], Target) Is Nothing And Target.Count = 1 Then
        Application.EnableEvents = False
            If Target <> 0 Then
                If InStr(Target.Text, ":") = 0 Then
                    Temp = Format(Target, "0000")
                    Temp = Left(Temp, 2) & ":" & Right(Temp, 2) & ""
                        If IsDate(Temp) Then
                            Target = Temp
                        End If
                End If
            End If
        Application.EnableEvents = True
    End If
End Sub

Meilleures salutations et bon week-end!

Thierry

Bonjour tchi456, sylvanu, Modeste geedee,

Voyez le fichier .xlsm joint et cette macro dans le code de la feuille "Heures" :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, UsedRange)
If Target Is Nothing Then Exit Sub
Dim x$
Application.EnableEvents = False 'désactive les évènements
For Each Target In Target 'si entrées multiples
    If CStr(Target) Like "###" Or CStr(Target) Like "####" Then
        x = Format(Target, "0000")
        If Left(x, 2) < "24" And Right(x, 2) < "60" Then Target = Left(x, 2) & ":" & Right(x, 2)
    End If
Next
Application.EnableEvents = True 'réactive les évènements
End Sub
Les heures peuvent être entrées n'importe où sous la forme 815 pour 08:15 ou 2359 pour 23:59.

A+
Bonjour Job75,

Est-il possible d'adapter votre code qui fonctionne très bien pour pouvoir insérer également une date rapidement en 4, 5 ou 6 chiffres et que ça note cette date en 6 chiffres avec un points entre le jour.mois.année ?

Mes meilleures salutations,
Thierry
 

tchi456

XLDnaute Occasionnel
Bonjour Job75,

Est-il possible d'adapter votre code qui fonctionne très bien pour pouvoir insérer également une date rapidement en 4, 5 ou 6 chiffres et que ça note cette date en 6 chiffres avec un points entre le jour.mois.année ?

Mes meilleures salutations,
Thierry
J'imaginais ceci mais ça me donne une date complètement différente:
VB:
Private Sub Worksheet_Change2(ByVal Target As Range)
Set Target = Intersect(Target, UsedRange)
If Target Is Nothing Then Exit Sub
Dim x$
Application.EnableEvents = False 'désactive les évènements
For Each Target In Target 'si entrées multiples
    If CStr(Target) Like "######" Or CStr(Target) Like "#######" Or CStr(Target) Like "########" Then
        x = Format(Target, "00000000")
        If Left(x, 2) > "1" < "31" And Mid(x, 2) > "1" < "12" And Right > "2000" < "3000" Then Target = Left(x, 2) & "." & Mid(x, 2) & "." & Right(x, 4)
    End If
Next
Application.EnableEvents = True 'réactive les évènements
End Sub
 

tchi456

XLDnaute Occasionnel
Bonjour tchi456, le fil,

Ce n'est plus du tout le sujet de ce fil.

Comme le préconise la Charte du forum, créez une nouvelle discussion.

A+
Bonjour Job,

C'est noté. Voici le lien ci-dessous :


Bon week-end !
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
314 630
Messages
2 111 365
Membres
111 114
dernier inscrit
ADA1327