XL 2010 [Résolu] Imbriquer 2 Worksheet_change

[Saxophone]

Bonjour à tous,
J'ai bien fouillé le forum avant de m'inscrire et poster ma demande.
Je souhaite faciliter la saisie de données dans plusieurs colonnes.
Colonne E et G : l'utilisateur n'a pas à saisir les slash pour les dates (format jj/mm/aaaa)
Colonne F et H : l'utilisateur n'a pas à saisir les " : " pour les heures (format souhaité hh:mm)

J'ai trouvé les codes qui font le travail, seulement impossible en les triturant de les faire fonctionner tous les deux sur la même feuille, séparément ils fonctionnent.

Je vous remercie par avance.
Cordialement.

Le code : (je n'ai pas trouvé de menu permettant de le mettre plus en forme pour le forum :s)

1. Option Explicit
2. Private Sub Worksheet_Change(ByVal Target As Excel.Range)
3. Dim DateStr As String
4. 'On Error GoTo EndMacro
5. 'On Error GoTo HeureMauvaise

1. If Target.Cells.Count > 1 Then Exit Sub
2. If Target.Value = "" Then Exit Sub
3. If Application.Intersect(Target, Union(Range("E7:E100"), Range("G7:G100"))) Is Nothing Then
4. Application.EnableEvents = False
5. Target.NumberFormat = "General"
6. If Target.HasFormula = False Then
7. Select Case Len(Target.Formula)
8. Case 5
9. DateStr = Left(Target.Formula, 1) & "/" & Mid(Target.Formula, 2, 2) & "/" & Right(Target.Formula, 2)
10. Case 6
11. DateStr = Left(Target.Formula, 2) & "/" & Mid(Target.Formula, 3, 2) & "/" & Right(Target.Formula, 2)
12. Case Else
13. Err.Raise 0
14. End Select
15. Target.Formula = DateValue(DateStr)
16. Target.NumberFormat = "dd/mm/yyyy"
17. End If
18. Application.EnableEvents = True
19. End If
20. If Not Intersect(Target, Union(Range("F7:F100"), Range("H7:H100"))) Is Nothing Then
21. Application.EnableEvents = False
22. Select Case Len(Target)
23. Case 1, 2
24. Target = CDate("0:" & Target)
25. Target.NumberFormat = "hh:mm;@"
26. Case 3
27. Target = CDate(Left(Target, 1) & ":" & Mid(Target, 2))
28. Target.NumberFormat = "hh:mm;@"
29. Case 4
30. Target = CDate(Left(Target, 2) & ":" & Mid(Target, 3))
31. Target.NumberFormat = "hh:mm;@"
32. End Select
33. Application.EnableEvents = True
34. End If
35. End Sub
36. 'EndMacro:
37. 'Target.ClearContents
38. 'Target.Select
39. 'MsgBox "En " & Replace(Target.Address, "$", "") & ", il faut saisir une date valide" & Chr(10) & Chr(10) & " avec un format: jmmaa ou jjmmaa"
40. 'Application.EnableEvents = True
42. 'HeureMauvaise:
43. 'Target.ClearContents
44. 'Target.Select
45. 'MsgBox "En " & Replace(Target.Address, "$", "") & ", il faut saisir une heure valide" & Chr(10) & Chr(10) & " avec un format: hhmm"
46. 'Application.EnableEvents = True

 

[Hieu]

Salut,

As-tu essayé quelque chose comme ça ??

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DateStr As String
'On Error GoTo EndMacro
'On Error GoTo HeureMauvaise
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If  Not Application.Intersect(Target, Range("E7:E100, G7:G100")) Is Nothing Then call FormatDate(Target)
If  Not Application.Intersect(Target, Range("F7:F100, H7:H100")) Is Nothing Then call FormatHeure(Target)
End Sub

En créant les subroutines qui fonctionnent bien ?


Pour représenter tu tapes ton code entre : [co de = vb ] et [/co de] (sans les espaces)

 

[Saxophone]

Tu as résolu ma situation. Merci merci merci!
Effectivement j'ai créé 2 modules avec les Sub que tu m'as suggéré.
Il me reste à ajouter des alertes en cas de problème de saisi.
Encore merci c'est vraiment impeccable !
Bonne soirée.