Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Appliquer une procédure à une cellule ou une plage de cellules

Appliquer une procédure à une cellule ou une plage de cellules

1 réponse
Avatar
Jean-Marie GILTAIRE
Bonjour,
Voici ma procédure. Elle fonctionne avec une cellule à la fois, notamment
lorsque je delete le contenu de ma cellule et qu'il me remet la couleur à
xlNone (voir Case "" dans le code). Je voudrais pouvoir appliquer cela
lorsque je sélectionne une plage de cellules. Quelqu'un aurait-il une idée ?
Merci d'avance.

Jean-Marie

Voici mon code :
Private Sub Worksheet_Change(ByVal Target As Range)

'restreindre le coloriage des cellules uniquement aux plages horaires
If Target.Column >= 7 And Target.Column <= 38 Then
Select Case Target.Row Mod 9
'toutes les 9 lignes à partir de la ligne 5 (à adapter selon les
horaires)
Case 5
Dim cellcol, ligne As Long
Dim Mydate, MyWeekDay, NomFerie
On Error GoTo ErrHandler:

'déprotéger la feuille (car les cellules ne peuvent pas se
colorier si feuille protégée)
ActiveSheet.Unprotect Password:="hello"
cellcol = Target.Column
ligne = Target.Row
'prise en compte des jours de la semaine et des fériés
'pour ne pas changer la couleur de ces cellules si elles
sont vides
Mydate = Cells(3, cellcol)
MyWeekDay = Weekday(Mydate)
NomFerie = "ferie" & ActiveSheet.Name
'tester les codes horaires et leur appliquer la couleur
adéquate
With Target
Select Case Target
Case "A", "AE", "AR", "AM", "a", "aE", "aR", "aM"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C1").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C1").Interior.ColorIndex
.Font.Size = 18
Case "B", "BE", "BR", "BM", "b", "bE", "bR", "bM"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C2").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C2").Interior.ColorIndex
.Font.Size = 18
Case "C", "CE", "CR", "CM", "c", "cE", "cR", "cM"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C3").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C3").Interior.ColorIndex
.Font.Size = 18
Case "D", "DE", "DR", "DM", "d", "dE", "dR", "dM"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C4").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C4").Interior.ColorIndex
.Font.Size = 18
Case "E", "EE", "ER", "EM"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C5").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C5").Interior.ColorIndex
.Font.Size = 18
Case "CA", "CA2"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C39").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C39").Interior.ColorIndex
.Font.Size = 18
Case "JF"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C40").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C40").Interior.ColorIndex
.Font.Size = 18
Case "CC"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C41").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C41").Interior.ColorIndex
.Font.Size = 18
Case "MA"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C42").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C42").Interior.ColorIndex
.Font.Size = 18
Case "DT"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C43").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C43").Interior.ColorIndex
.Font.Size = 18
Case "RA", "CF", "AL", "AT", "CS", "MP"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C44").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C44").Interior.ColorIndex
.Font.Size = 18
Case "FO", "SY"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C50").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C50").Interior.ColorIndex
.Font.Size = 18
Case "P"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C53").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C53").Interior.ColorIndex
.Font.Size = 18
Case "\"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C11").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C11").Interior.ColorIndex
.Font.Size = 18
Case "A" To "E" & "CA2", "a" To "d" & "CA2"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C52").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C52").Interior.ColorIndex
.Font.Size = 14
Case ""
If MyWeekDay = 1 Or MyWeekDay = 7 Then
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C11").Interior.ColorIndex
ElseIf Not
IsError(Application.Match(CLng(Mydate), Range("Feries2004"), 0)) Then
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C40").Interior.ColorIndex
Else
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 1
End If
Case Else
If Target.Column >= 7 And Target.Column <= 38
Then
If (Val(Target.Row) - 5) Mod 9 = 0 Then
.Font.Size = 18
.Font.ColorIndex = 1
End If
End If
End Select
End With
'reprotéger la feuille
With ActiveSheet
.Protect Password:="hello",
UserInterfaceOnly:=True, Contents:=True
.EnableAutoFilter = True
.EnableOutlining = True
End With
Application.Calculate
Exit Sub
ErrHandler:
If Err.Number = 1004 Then
Target.Interior.ColorIndex = xlNone
Target.Font.ColorIndex = 1
Exit Sub
End If
Case Else
If Target.Locked = True Then
With ActiveSheet
.Protect Password:="hello",
UserInterfaceOnly:=True, Contents:=True
.EnableAutoFilter = True
.EnableOutlining = True
End With
End If
End Select
End If
End Sub
Signaler un problème avec ce contenu

1 réponse

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
isabelle
bonjour Jean-Marie,

peut être que ce bout de code pourra t'inspirer pour modifier ta
procédure avec un événement Worksheet_SelectionChange

Sub Macro1()
Set Plage = Range("A1:B10")
Set plg = Application.Intersect(Plage, Selection)
If Not plg Is Nothing Then
plg.Select
Else
MsgBox "pas d'intersection"
End If
End Sub

isabelle


Bonjour,
Voici ma procédure. Elle fonctionne avec une cellule à la fois, notamment
lorsque je delete le contenu de ma cellule et qu'il me remet la couleur à
xlNone (voir Case "" dans le code). Je voudrais pouvoir appliquer cela
lorsque je sélectionne une plage de cellules. Quelqu'un aurait-il une idée ?
Merci d'avance.

Jean-Marie

Voici mon code :
Private Sub Worksheet_Change(ByVal Target As Range)

'restreindre le coloriage des cellules uniquement aux plages horaires
If Target.Column >= 7 And Target.Column <= 38 Then
Select Case Target.Row Mod 9
'toutes les 9 lignes à partir de la ligne 5 (à adapter selon les
horaires)
Case 5
Dim cellcol, ligne As Long
Dim Mydate, MyWeekDay, NomFerie
On Error GoTo ErrHandler:

'déprotéger la feuille (car les cellules ne peuvent pas se
colorier si feuille protégée)
ActiveSheet.Unprotect Password:="hello"
cellcol = Target.Column
ligne = Target.Row
'prise en compte des jours de la semaine et des fériés
'pour ne pas changer la couleur de ces cellules si elles
sont vides
Mydate = Cells(3, cellcol)
MyWeekDay = Weekday(Mydate)
NomFerie = "ferie" & ActiveSheet.Name
'tester les codes horaires et leur appliquer la couleur
adéquate
With Target
Select Case Target
Case "A", "AE", "AR", "AM", "a", "aE", "aR", "aM"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C1").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C1").Interior.ColorIndex
.Font.Size = 18
Case "B", "BE", "BR", "BM", "b", "bE", "bR", "bM"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C2").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C2").Interior.ColorIndex
.Font.Size = 18
Case "C", "CE", "CR", "CM", "c", "cE", "cR", "cM"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C3").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C3").Interior.ColorIndex
.Font.Size = 18
Case "D", "DE", "DR", "DM", "d", "dE", "dR", "dM"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C4").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C4").Interior.ColorIndex
.Font.Size = 18
Case "E", "EE", "ER", "EM"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C5").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C5").Interior.ColorIndex
.Font.Size = 18
Case "CA", "CA2"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C39").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C39").Interior.ColorIndex
.Font.Size = 18
Case "JF"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C40").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C40").Interior.ColorIndex
.Font.Size = 18
Case "CC"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C41").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C41").Interior.ColorIndex
.Font.Size = 18
Case "MA"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C42").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C42").Interior.ColorIndex
.Font.Size = 18
Case "DT"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C43").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C43").Interior.ColorIndex
.Font.Size = 18
Case "RA", "CF", "AL", "AT", "CS", "MP"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C44").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C44").Interior.ColorIndex
.Font.Size = 18
Case "FO", "SY"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C50").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C50").Interior.ColorIndex
.Font.Size = 18
Case "P"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C53").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C53").Interior.ColorIndex
.Font.Size = 18
Case ""
.Font.ColorIndex = Sheets("Fériés
2004").Range("C11").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C11").Interior.ColorIndex
.Font.Size = 18
Case "A" To "E" & "CA2", "a" To "d" & "CA2"
.Font.ColorIndex = Sheets("Fériés
2004").Range("C52").Font.ColorIndex
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C52").Interior.ColorIndex
.Font.Size = 14
Case ""
If MyWeekDay = 1 Or MyWeekDay = 7 Then
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C11").Interior.ColorIndex
ElseIf Not
IsError(Application.Match(CLng(Mydate), Range("Feries2004"), 0)) Then
.Interior.ColorIndex = Sheets("Fériés
2004").Range("C40").Interior.ColorIndex
Else
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 1
End If
Case Else
If Target.Column >= 7 And Target.Column <= 38
Then
If (Val(Target.Row) - 5) Mod 9 = 0 Then
.Font.Size = 18
.Font.ColorIndex = 1
End If
End If
End Select
End With
'reprotéger la feuille
With ActiveSheet
.Protect Password:="hello",
UserInterfaceOnly:=True, Contents:=True
.EnableAutoFilter = True
.EnableOutlining = True
End With
Application.Calculate
Exit Sub
ErrHandler:
If Err.Number = 1004 Then
Target.Interior.ColorIndex = xlNone
Target.Font.ColorIndex = 1
Exit Sub
End If
Case Else
If Target.Locked = True Then
With ActiveSheet
.Protect Password:="hello",
UserInterfaceOnly:=True, Contents:=True
.EnableAutoFilter = True
.EnableOutlining = True
End With
End If
End Select
End If
End Sub