Private Sub Worksheet_Change(ByVal Target As Range) : Appliquer à différentes plages

[blord]

Bonjour à tous,

Hier James007 (merci beaucoup !) à conçu ce petit bout de code pour m'aider. Ce code permet à l'utilisateur de ne pas avoir à saisir les ":" et à valider que la saisie est bien une heure valide.

Je pensais n'avoir à appliquer ce code que sur une seule cellule de ma feuille mais j'aimerais pouvoir l'appliquer à plusieurs ranges de cellules distincts comme par exemple :

C7:I8
C11:I12
C15:I16
C22:I38

J'ai fait quelques tentatives lamentables mais sans succès... Si quelqu'un pouvait m'aider à mettre en place le tout, se serait vraiment apprécié...


Benoit Lord

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$C$7" Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub

Dim DateStr As String
On Error GoTo EndMacro

Application.EnableEvents = False
    Target.NumberFormat = "General"
    If Target.HasFormula = False Then
        Select Case Len(Target.Formula)
            Case 3
                DateStr = Left(Target.Formula, 1) & ":" & Right(Target.Formula, 2)
            Case 4
                DateStr = Left(Target.Formula, 2) & ":" & Right(Target.Formula, 2)
            Case Else
                Err.Raise 0
        End Select
        Target.Formula = CDate(DateStr)
        Target.NumberFormat = "hh:mm"
    End If
Application.EnableEvents = True
Exit Sub

EndMacro:
    Target.ClearContents
    Target.Select
    MsgBox "Il faut saisir une Heure Valide" & Chr(10) & Chr(10) & "avec un format: hmm ou hhmm"
    Application.EnableEvents = True

End Sub

 

[blord]

Re : Private Sub Worksheet_Change(ByVal Target As Range) : Appliquer à différentes pl

Bonjour à tous,

J'ai finalement trouvé en consultant différents exemples sur le forum :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

[COLOR="red"]If Application.Intersect(Target, Range("C7:I8")) Is Nothing And Application.Intersect(Target, Range("C10:I11")) Is Nothing _
And Application.Intersect(Target, Range("C15:I16")) Is Nothing And Application.Intersect(Target, Range("C22:I38")) Is Nothing Then Exit Sub[/COLOR]


'If Target.Address <> "$C$7" Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub

Dim DateStr As String
On Error GoTo EndMacro

Application.EnableEvents = False
    Target.NumberFormat = "General"
    If Target.HasFormula = False Then
        Select Case Len(Target.Formula)
            Case 3
                DateStr = Left(Target.Formula, 1) & ":" & Right(Target.Formula, 2)
            Case 4
                DateStr = Left(Target.Formula, 2) & ":" & Right(Target.Formula, 2)
            Case Else
                Err.Raise 0
        End Select
        Target.Formula = CDate(DateStr)
        Target.NumberFormat = "hh:mm"
    End If
Application.EnableEvents = True
Exit Sub

EndMacro:
    Target.ClearContents
    Target.Select
    MsgBox "Il faut saisir une Heure Valide" & Chr(10) & Chr(10) & "avec un format: hmm ou hhmm"
    Application.EnableEvents = True

End Sub

Bonne soirée à tous !

Benoit Lord

 

[Dull]

Re : Private Sub Worksheet_Change(ByVal Target As Range) : Appliquer à différentes pl

Salut blord, le Forum

tu peut aussi remplacer cette partie de ton code

If Application.Intersect(Target, Range("C7:I8")) Is Nothing And Application.Intersect(Target, Range("C10:I11")) Is Nothing _
And Application.Intersect(Target, Range("C15:I16")) Is Nothing And Application.Intersect(Target, Range("C22:I38")) Is Nothing Then Exit Sub

par celle ci

If Application.Intersect(Target, Range("C7:I8,C10:I11,C15:I16,C22:I38")) Is Nothing Then Exit Sub

Bonne Journée

 

[blord]

Re : Private Sub Worksheet_Change(ByVal Target As Range) : Appliquer à différentes pl

Salut Dull, le Forum,

Merci pour l'information, ça rend effectivement le code plus facile à lire....


Bonne journée !

Benoit Lord