Regueiro
XLDnaute Impliqué
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 :
Merci de votre Aide.
A+
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 :
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
A+