'Yeahou - la saisie horaire simplifiée - 21/07/2005
Option Explicit
'Variable module
Dim Traitement_en_Cours As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
'Sortie si traitement en cours
If Traitement_en_Cours = True Then Exit Sub
'Déclaration des variables
Dim Compteur As Integer, Compteur2 As Integer, Compteur3 As Integer, Compteur4 As Integer
Dim Test_Depasse As Boolean, Test_Negatif As Boolean, Test_Secondes As Boolean, Test_Minutes As Boolean, Test_Heures As Boolean
Dim Target_en_Cours As Range, Target_Temp As Variant, Cellule_NumberFormat As String
'réinitialisation si erreur
On Error GoTo Fin
'Traitement si saisie d'une cellule
If Target.Count = 1 Then
'Traitement si non vide et non résultat formule
If Not (Target.Value = "") And Not (Left(Target.Formula, 1) = "=") Then
'Réduction de NumberFormat aux types traités pour analyse
Cellule_NumberFormat = Target.NumberFormat
Do
Compteur = InStr(1, Cellule_NumberFormat, Chr(34), 1)
If Compteur > 0 Then Compteur2 = InStr(Compteur + 1, Cellule_NumberFormat, Chr(34), 1) _
Else Compteur2 = 0
If Compteur2 = 0 Then Compteur = 0
If Compteur > 0 Then Cellule_NumberFormat = Left(Cellule_NumberFormat, Compteur - 1) & _
Right(Cellule_NumberFormat, Len(Cellule_NumberFormat) - Compteur2)
Loop Until Compteur = 0
'Test secondes, minutes, heures
If InStr(1, Cellule_NumberFormat, "s", 0) > 0 Then Test_Secondes = True
If InStr(1, Cellule_NumberFormat, "m", 0) > 0 Then Test_Minutes = True
If InStr(1, Cellule_NumberFormat, "h", 0) > 0 Then Test_Heures = True
'Traitement si format horaire
If Test_Secondes Or Test_Minutes Or Test_Heures Then
'Initialisation Target_Temp
Target_Temp = Target.Value
'Test de la valeur jour présent et transformation en long pour traitement
Compteur2 = 0
Compteur3 = 0
For Compteur = 1 To Len(Target_Temp)
If Mid(Target_Temp, Compteur, 1) = ":" Then Compteur2 = Compteur2 + 1
If Mid(Target_Temp, Compteur, 1) = ":" And Compteur3 > 0 And Compteur4 = 0 Then Compteur4 = Compteur
If Mid(Target_Temp, Compteur, 1) = ":" And Compteur3 = 0 Then Compteur3 = Compteur
Next Compteur
If Compteur2 = 3 Then
Target.Value = (Left(Target_Temp, Compteur3 - 1) * 24) + Mid(Target_Temp, Compteur3 + 1, (Compteur4 - Compteur3) - 1) & Right(Target_Temp, Len(Target_Temp) + 1 - Compteur4)
Target_Temp = Target.Value
Compteur2 = 0
End If
'Test de la valeur > "9999:00" et transformation en long pour traitement
Test_Depasse = False
If InStr(1, Target_Temp, ":", 0) > 0 And Not (IsNumeric(Target_Temp)) Then
Test_Depasse = True
If Test_Heures And Test_Minutes And Test_Secondes Then
Target_Temp = (Left(Target_Temp, InStr(1, Target_Temp, ":", 0) - 1)) & (Mid(Target_Temp, InStr(1, Target_Temp, ":", 0) + 1, 2)) & (Right(Target_Temp, 2))
Else
Target_Temp = (Left(Target_Temp, InStr(1, Target_Temp, ":", 0) - 1)) & (Right(Target_Temp, 2))
End If
End If
'Test de la valeur numérique et abandon traitement cellule si faux
If IsNumeric(Target_Temp) Then
'Abandon traitement cellule <1
If Abs(Target_Temp) >= 1 Then
'Test des valeurs numériques
If Target_Temp < 0 Then Test_Negatif = True: Target_Temp = -Target_Temp
'Test de target en entier long et traitement si positif
If Target_Temp = (Target_Temp \ 1) Or Test_Depasse = True Then
'Traitement avec secondes ou non
If Test_Secondes Then
If Test_Minutes Or Test_Heures Then
Select Case Len(Target_Temp)
Case Is < 3
Target_Temp = Target_Temp / 86400
Case Is < 5
Target_Temp = (Left(Target_Temp, Len(Target_Temp) - 2) / 1440) + _
(Right(Target_Temp, 2) / 86400)
Case Else
Target_Temp = (Left(Target_Temp, Len(Target_Temp) - 4) / 24) + _
(Left(Right(Target_Temp, 4), 2) / 1440) + (Right(Target_Temp, 2) / 86400)
End Select
Else
Target_Temp = Target_Temp / 86400
End If
Else
If Test_Minutes Then
If Test_Heures Then
Select Case Len(Target_Temp)
Case Is < 3
Target_Temp = Target_Temp / 1440
Case Else
Target_Temp = (Left(Target_Temp, Len(Target_Temp) - 2) / 24) + _
(Right(Target_Temp, 2) / 1440)
End Select
Else
Target_Temp = Target_Temp / 1440
End If
Else
Target_Temp = Target_Temp / 24
End If
End If
'Annulation Worksheet_Change pendant traitement
Traitement_en_Cours = True
'Traitement de Target_Temp selon signe et type calendrier
If Test_Negatif = True Then
If ThisWorkbook.Date1904 = True Then
Target.Value = -Target_Temp
Else
Target.Value = Target_Temp
Target.Value = "'-" & Target.Text
End If
Else
Target.Value = Target_Temp
End If
End If
End If
End If
End If
End If
End If
Fin:
Traitement_en_Cours = False
End Sub