Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is =3D "Bolo"
c.Offset(0, 0).Interior.ColorIndex =3D 39
Case Is =3D "Mama"
c.Offset(0, 0).Interior.ColorIndex =3D 36
Case Is =3D "Bien"
c.Offset(0, 0).Interior.ColorIndex =3D 37
Case Is =3D "CC Popo"
c.Offset(0, 0).Interior.ColorIndex =3D 35
Case Is =3D "CC Papa"
c.Offset(0, 0).Interior.ColorIndex =3D 38
Case Else
c.Offset(0, 0).Interior.ColorIndex =3D 0
End Select
Next
End If
End Sub
Je souhaiterais pouvoir inclure dans la mise en page TOUTES les cellules =
qui contiennent les crit=E8res, m=EAme si elles sont plus longues.
Exemple, la mise en page du premier cas devrait aussi s'appliquer =E0 une=
=20
cellule qui contiendrait "trois Bolo" ou "Bolo =E0 la cr=E8me", ou "Bolo=
s".
Dans cette version si le contenu n'est pas exactement celui sp=E9cifi=E9,=
=20
rien ne se passe. Comment utiliser un "jocker" (*); est-ce possible ?
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
MichDenis
Bonjour Pierre,
Essaie ça :
Private Sub Worksheet_change(ByVal Target As Range) Dim c As Range If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target If InStr(1, c.Value, "bolo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 39 ElseIf InStr(1, c.Value, "mama", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 36 ElseIf InStr(1, c.Value, "bien", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 37 ElseIf InStr(1, c.Value, "cc popo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 35 ElseIf InStr(1, c.Value, "cc papa", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 38 Else c.Offset(0, 0).Interior.ColorIndex = 0 End If Next End If End Sub
"Pierre F." a écrit dans le message de groupe de discussion : 8c8c7$4a896f40$55da2ee3$ Bonjour à toutes et tous;
Dans un worksheet, j'ai le code suivant
Private Sub Worksheet_change(ByVal Target As Range) Dim c As Range If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target Select Case c.Value
Case Is = "Bolo" c.Offset(0, 0).Interior.ColorIndex = 39 Case Is = "Mama" c.Offset(0, 0).Interior.ColorIndex = 36 Case Is = "Bien" c.Offset(0, 0).Interior.ColorIndex = 37 Case Is = "CC Popo" c.Offset(0, 0).Interior.ColorIndex = 35 Case Is = "CC Papa" c.Offset(0, 0).Interior.ColorIndex = 38 Case Else c.Offset(0, 0).Interior.ColorIndex = 0
End Select Next End If End Sub
Je souhaiterais pouvoir inclure dans la mise en page TOUTES les cellules qui contiennent les critères, même si elles sont plus longues.
Exemple, la mise en page du premier cas devrait aussi s'appliquer à une cellule qui contiendrait "trois Bolo" ou "Bolo à la crème", ou "Bolos".
Dans cette version si le contenu n'est pas exactement celui spécifié, rien ne se passe. Comment utiliser un "jocker" (*); est-ce possible ?
Merci pour votre aide.
Pierre F.
Bonjour Pierre,
Essaie ça :
Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then
For Each c In Target
If InStr(1, c.Value, "bolo", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 39
ElseIf InStr(1, c.Value, "mama", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 36
ElseIf InStr(1, c.Value, "bien", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 37
ElseIf InStr(1, c.Value, "cc popo", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 35
ElseIf InStr(1, c.Value, "cc papa", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 38
Else
c.Offset(0, 0).Interior.ColorIndex = 0
End If
Next
End If
End Sub
"Pierre F." <pfornerodNO@SPAMhotmail.ch> a écrit dans le message de groupe de discussion :
8c8c7$4a896f40$55da2ee3$29279@news.hispeed.ch...
Bonjour à toutes et tous;
Dans un worksheet, j'ai le code suivant
Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = "Bolo"
c.Offset(0, 0).Interior.ColorIndex = 39
Case Is = "Mama"
c.Offset(0, 0).Interior.ColorIndex = 36
Case Is = "Bien"
c.Offset(0, 0).Interior.ColorIndex = 37
Case Is = "CC Popo"
c.Offset(0, 0).Interior.ColorIndex = 35
Case Is = "CC Papa"
c.Offset(0, 0).Interior.ColorIndex = 38
Case Else
c.Offset(0, 0).Interior.ColorIndex = 0
End Select
Next
End If
End Sub
Je souhaiterais pouvoir inclure dans la mise en page TOUTES les cellules
qui contiennent les critères, même si elles sont plus longues.
Exemple, la mise en page du premier cas devrait aussi s'appliquer à une
cellule qui contiendrait "trois Bolo" ou "Bolo à la crème", ou "Bolos".
Dans cette version si le contenu n'est pas exactement celui spécifié,
rien ne se passe. Comment utiliser un "jocker" (*); est-ce possible ?
Private Sub Worksheet_change(ByVal Target As Range) Dim c As Range If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target If InStr(1, c.Value, "bolo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 39 ElseIf InStr(1, c.Value, "mama", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 36 ElseIf InStr(1, c.Value, "bien", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 37 ElseIf InStr(1, c.Value, "cc popo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 35 ElseIf InStr(1, c.Value, "cc papa", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 38 Else c.Offset(0, 0).Interior.ColorIndex = 0 End If Next End If End Sub
"Pierre F." a écrit dans le message de groupe de discussion : 8c8c7$4a896f40$55da2ee3$ Bonjour à toutes et tous;
Dans un worksheet, j'ai le code suivant
Private Sub Worksheet_change(ByVal Target As Range) Dim c As Range If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target Select Case c.Value
Case Is = "Bolo" c.Offset(0, 0).Interior.ColorIndex = 39 Case Is = "Mama" c.Offset(0, 0).Interior.ColorIndex = 36 Case Is = "Bien" c.Offset(0, 0).Interior.ColorIndex = 37 Case Is = "CC Popo" c.Offset(0, 0).Interior.ColorIndex = 35 Case Is = "CC Papa" c.Offset(0, 0).Interior.ColorIndex = 38 Case Else c.Offset(0, 0).Interior.ColorIndex = 0
End Select Next End If End Sub
Je souhaiterais pouvoir inclure dans la mise en page TOUTES les cellules qui contiennent les critères, même si elles sont plus longues.
Exemple, la mise en page du premier cas devrait aussi s'appliquer à une cellule qui contiendrait "trois Bolo" ou "Bolo à la crème", ou "Bolos".
Dans cette version si le contenu n'est pas exactement celui spécifié, rien ne se passe. Comment utiliser un "jocker" (*); est-ce possible ?
Merci pour votre aide.
Pierre F.
Mima
Bonjour Définir une plage contenant tous les noms "génériques" Attention, la comparaison est sensible à la casse
Private Sub Worksheet_change(ByVal Target As Range) Dim c As Range Dim Rep, V If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target
'''<<<Comparaison du contenu de la cellule avec la liste référence nommée>>> For Each V In Range("RefCat") If c.Value Like "*" & V & "*" Then Rep = V Next
'''<<<Select case avec le résultat de la Comparaison Select Case Rep Case Is = "Bolo" c.Offset(0, 0).Interior.ColorIndex = 39 Case Is = "Mama" c.Offset(0, 0).Interior.ColorIndex = 36 Case Is = "Bien" c.Offset(0, 0).Interior.ColorIndex = 37 Case Is = "CC Popo" c.Offset(0, 0).Interior.ColorIndex = 35 Case Is = "CC Papa" c.Offset(0, 0).Interior.ColorIndex = 38 Case Else c.Offset(0, 0).Interior.ColorIndex = 0 End Select Next End If End Sub
MiMa
"Pierre F." a écrit dans le message de news: 8c8c7$4a896f40$55da2ee3$ Bonjour à toutes et tous;
Dans un worksheet, j'ai le code suivant
Private Sub Worksheet_change(ByVal Target As Range) Dim c As Range If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target Select Case c.Value
Case Is = "Bolo" c.Offset(0, 0).Interior.ColorIndex = 39 Case Is = "Mama" c.Offset(0, 0).Interior.ColorIndex = 36 Case Is = "Bien" c.Offset(0, 0).Interior.ColorIndex = 37 Case Is = "CC Popo" c.Offset(0, 0).Interior.ColorIndex = 35 Case Is = "CC Papa" c.Offset(0, 0).Interior.ColorIndex = 38 Case Else c.Offset(0, 0).Interior.ColorIndex = 0
End Select Next End If End Sub
Je souhaiterais pouvoir inclure dans la mise en page TOUTES les cellules qui contiennent les critères, même si elles sont plus longues.
Exemple, la mise en page du premier cas devrait aussi s'appliquer à une cellule qui contiendrait "trois Bolo" ou "Bolo à la crème", ou "Bolos".
Dans cette version si le contenu n'est pas exactement celui spécifié, rien ne se passe. Comment utiliser un "jocker" (*); est-ce possible ?
Merci pour votre aide.
Pierre F.
Bonjour
Définir une plage contenant tous les noms "génériques"
Attention, la comparaison est sensible à la casse
Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rep, V
If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then
For Each c In Target
'''<<<Comparaison du contenu de la cellule avec la liste référence
nommée>>>
For Each V In Range("RefCat")
If c.Value Like "*" & V & "*" Then Rep = V
Next
'''<<<Select case avec le résultat de la Comparaison
Select Case Rep
Case Is = "Bolo"
c.Offset(0, 0).Interior.ColorIndex = 39
Case Is = "Mama"
c.Offset(0, 0).Interior.ColorIndex = 36
Case Is = "Bien"
c.Offset(0, 0).Interior.ColorIndex = 37
Case Is = "CC Popo"
c.Offset(0, 0).Interior.ColorIndex = 35
Case Is = "CC Papa"
c.Offset(0, 0).Interior.ColorIndex = 38
Case Else
c.Offset(0, 0).Interior.ColorIndex = 0
End Select
Next
End If
End Sub
MiMa
"Pierre F." <pfornerodNO@SPAMhotmail.ch> a écrit dans le message de news:
8c8c7$4a896f40$55da2ee3$29279@news.hispeed.ch...
Bonjour à toutes et tous;
Dans un worksheet, j'ai le code suivant
Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = "Bolo"
c.Offset(0, 0).Interior.ColorIndex = 39
Case Is = "Mama"
c.Offset(0, 0).Interior.ColorIndex = 36
Case Is = "Bien"
c.Offset(0, 0).Interior.ColorIndex = 37
Case Is = "CC Popo"
c.Offset(0, 0).Interior.ColorIndex = 35
Case Is = "CC Papa"
c.Offset(0, 0).Interior.ColorIndex = 38
Case Else
c.Offset(0, 0).Interior.ColorIndex = 0
End Select
Next
End If
End Sub
Je souhaiterais pouvoir inclure dans la mise en page TOUTES les cellules
qui contiennent les critères, même si elles sont plus longues.
Exemple, la mise en page du premier cas devrait aussi s'appliquer à une
cellule qui contiendrait "trois Bolo" ou "Bolo à la crème", ou "Bolos".
Dans cette version si le contenu n'est pas exactement celui spécifié,
rien ne se passe. Comment utiliser un "jocker" (*); est-ce possible ?
Bonjour Définir une plage contenant tous les noms "génériques" Attention, la comparaison est sensible à la casse
Private Sub Worksheet_change(ByVal Target As Range) Dim c As Range Dim Rep, V If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target
'''<<<Comparaison du contenu de la cellule avec la liste référence nommée>>> For Each V In Range("RefCat") If c.Value Like "*" & V & "*" Then Rep = V Next
'''<<<Select case avec le résultat de la Comparaison Select Case Rep Case Is = "Bolo" c.Offset(0, 0).Interior.ColorIndex = 39 Case Is = "Mama" c.Offset(0, 0).Interior.ColorIndex = 36 Case Is = "Bien" c.Offset(0, 0).Interior.ColorIndex = 37 Case Is = "CC Popo" c.Offset(0, 0).Interior.ColorIndex = 35 Case Is = "CC Papa" c.Offset(0, 0).Interior.ColorIndex = 38 Case Else c.Offset(0, 0).Interior.ColorIndex = 0 End Select Next End If End Sub
MiMa
"Pierre F." a écrit dans le message de news: 8c8c7$4a896f40$55da2ee3$ Bonjour à toutes et tous;
Dans un worksheet, j'ai le code suivant
Private Sub Worksheet_change(ByVal Target As Range) Dim c As Range If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target Select Case c.Value
Case Is = "Bolo" c.Offset(0, 0).Interior.ColorIndex = 39 Case Is = "Mama" c.Offset(0, 0).Interior.ColorIndex = 36 Case Is = "Bien" c.Offset(0, 0).Interior.ColorIndex = 37 Case Is = "CC Popo" c.Offset(0, 0).Interior.ColorIndex = 35 Case Is = "CC Papa" c.Offset(0, 0).Interior.ColorIndex = 38 Case Else c.Offset(0, 0).Interior.ColorIndex = 0
End Select Next End If End Sub
Je souhaiterais pouvoir inclure dans la mise en page TOUTES les cellules qui contiennent les critères, même si elles sont plus longues.
Exemple, la mise en page du premier cas devrait aussi s'appliquer à une cellule qui contiendrait "trois Bolo" ou "Bolo à la crème", ou "Bolos".
Dans cette version si le contenu n'est pas exactement celui spécifié, rien ne se passe. Comment utiliser un "jocker" (*); est-ce possible ?
Private Sub Worksheet_change(ByVal Target As Range) Dim c As Range If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target If InStr(1, c.Value, "bolo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 39 ElseIf InStr(1, c.Value, "mama", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 36 ElseIf InStr(1, c.Value, "bien", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 37 ElseIf InStr(1, c.Value, "cc popo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 35 ElseIf InStr(1, c.Value, "cc papa", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 38 Else c.Offset(0, 0).Interior.ColorIndex = 0 End If Next End If End Sub
Impeccable!! Merci! C'est exactement ça.
Question subsidiaire: serait-il possible d'appliquer cette mise en page à toutes les feuilles du classeur (workbook?) sans passer par le "pince au"?
Cordialement, Pierre F.
MichDenis a écrit :
Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then
For Each c In Target
If InStr(1, c.Value, "bolo", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 39
ElseIf InStr(1, c.Value, "mama", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 36
ElseIf InStr(1, c.Value, "bien", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 37
ElseIf InStr(1, c.Value, "cc popo", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 35
ElseIf InStr(1, c.Value, "cc papa", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 38
Else
c.Offset(0, 0).Interior.ColorIndex = 0
End If
Next
End If
End Sub
Impeccable!! Merci! C'est exactement ça.
Question subsidiaire: serait-il possible d'appliquer cette mise en page
à toutes les feuilles du classeur (workbook?) sans passer par le "pince au"?
Private Sub Worksheet_change(ByVal Target As Range) Dim c As Range If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target If InStr(1, c.Value, "bolo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 39 ElseIf InStr(1, c.Value, "mama", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 36 ElseIf InStr(1, c.Value, "bien", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 37 ElseIf InStr(1, c.Value, "cc popo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 35 ElseIf InStr(1, c.Value, "cc papa", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 38 Else c.Offset(0, 0).Interior.ColorIndex = 0 End If Next End If End Sub
Impeccable!! Merci! C'est exactement ça.
Question subsidiaire: serait-il possible d'appliquer cette mise en page à toutes les feuilles du classeur (workbook?) sans passer par le "pince au"?
Cordialement, Pierre F.
Pierre F.
Mima a écrit :
Bonjour Définir une plage contenant tous les noms "génériques" Attention, la comparaison est sensible à la casse
Private Sub Worksheet_change(ByVal Target As Range) Dim c As Range Dim Rep, V If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target
'<<<Comparaison du contenu de la cellule avec la liste réfé rence nommée>>> For Each V In Range("RefCat") If c.Value Like "*" & V & "*" Then Rep = V Next '<<<Select case avec le résultat de la Comparaison Select Case Rep Case Is = "Bolo" c.Offset(0, 0).Interior.ColorIndex = 39 Case Is = "Mama" c.Offset(0, 0).Interior.ColorIndex = 36 Case Is = "Bien" c.Offset(0, 0).Interior.ColorIndex = 37 Case Is = "CC Popo" c.Offset(0, 0).Interior.ColorIndex = 35 Case Is = "CC Papa" c.Offset(0, 0).Interior.ColorIndex = 38 Case Else c.Offset(0, 0).Interior.ColorIndex = 0 End Select Next End If End Sub
Bonjour MiMa
Merci pour cette soluce; Je souhaite appliquer cette mise en page aux 13 feuilles du classeur; dois-je définir la plage "générique" sur chaque feuille ?
Merci.
Cordialement, Pierre F.
Mima a écrit :
Bonjour
Définir une plage contenant tous les noms "génériques"
Attention, la comparaison est sensible à la casse
Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rep, V
If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then
For Each c In Target
'<<<Comparaison du contenu de la cellule avec la liste réfé rence
nommée>>>
For Each V In Range("RefCat")
If c.Value Like "*" & V & "*" Then Rep = V
Next
'<<<Select case avec le résultat de la Comparaison
Select Case Rep
Case Is = "Bolo"
c.Offset(0, 0).Interior.ColorIndex = 39
Case Is = "Mama"
c.Offset(0, 0).Interior.ColorIndex = 36
Case Is = "Bien"
c.Offset(0, 0).Interior.ColorIndex = 37
Case Is = "CC Popo"
c.Offset(0, 0).Interior.ColorIndex = 35
Case Is = "CC Papa"
c.Offset(0, 0).Interior.ColorIndex = 38
Case Else
c.Offset(0, 0).Interior.ColorIndex = 0
End Select
Next
End If
End Sub
Bonjour MiMa
Merci pour cette soluce;
Je souhaite appliquer cette mise en page aux 13 feuilles du classeur;
dois-je définir la plage "générique" sur chaque feuille ?
Bonjour Définir une plage contenant tous les noms "génériques" Attention, la comparaison est sensible à la casse
Private Sub Worksheet_change(ByVal Target As Range) Dim c As Range Dim Rep, V If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target
'<<<Comparaison du contenu de la cellule avec la liste réfé rence nommée>>> For Each V In Range("RefCat") If c.Value Like "*" & V & "*" Then Rep = V Next '<<<Select case avec le résultat de la Comparaison Select Case Rep Case Is = "Bolo" c.Offset(0, 0).Interior.ColorIndex = 39 Case Is = "Mama" c.Offset(0, 0).Interior.ColorIndex = 36 Case Is = "Bien" c.Offset(0, 0).Interior.ColorIndex = 37 Case Is = "CC Popo" c.Offset(0, 0).Interior.ColorIndex = 35 Case Is = "CC Papa" c.Offset(0, 0).Interior.ColorIndex = 38 Case Else c.Offset(0, 0).Interior.ColorIndex = 0 End Select Next End If End Sub
Bonjour MiMa
Merci pour cette soluce; Je souhaite appliquer cette mise en page aux 13 feuilles du classeur; dois-je définir la plage "générique" sur chaque feuille ?
Merci.
Cordialement, Pierre F.
Pierre F.
garnote a écrit :
Le Offset(0,0) me semble superfllu. Non ?
Bonjour Serge;
Effectivement j'ai repris la syntaxe d'un fichier où elle était plus utile. Toutefois, dans le cas présent, je la conserverai pour certains Case qu i me permettront des actions sur d'autres colonnes.
Cordialement, Pierre F.
garnote a écrit :
Le Offset(0,0) me semble superfllu. Non ?
Bonjour Serge;
Effectivement j'ai repris la syntaxe d'un fichier où elle était plus utile.
Toutefois, dans le cas présent, je la conserverai pour certains Case qu i
me permettront des actions sur d'autres colonnes.
Effectivement j'ai repris la syntaxe d'un fichier où elle était plus utile. Toutefois, dans le cas présent, je la conserverai pour certains Case qu i me permettront des actions sur d'autres colonnes.
Cordialement, Pierre F.
MichDenis
Tu utilises cet événement du ThisWorkbook :
Toutes les feuilles de calcul seront soumis à la même procédure ! '----------------------------------------- Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c As Range If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target If InStr(1, c.Value, "bolo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 39 ElseIf InStr(1, c.Value, "mama", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 36 ElseIf InStr(1, c.Value, "bien", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 37 ElseIf InStr(1, c.Value, "cc popo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 35 ElseIf InStr(1, c.Value, "cc papa", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 38 Else c.Offset(0, 0).Interior.ColorIndex = 0 End If Next End If End Sub '-----------------------------------------
"Pierre F." a écrit dans le message de groupe de discussion : 52757$4a897dd5$55da2ee3$ MichDenis a écrit :
Private Sub Worksheet_change(ByVal Target As Range) Dim c As Range If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target If InStr(1, c.Value, "bolo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 39 ElseIf InStr(1, c.Value, "mama", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 36 ElseIf InStr(1, c.Value, "bien", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 37 ElseIf InStr(1, c.Value, "cc popo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 35 ElseIf InStr(1, c.Value, "cc papa", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 38 Else c.Offset(0, 0).Interior.ColorIndex = 0 End If Next End If End Sub
Impeccable!! Merci! C'est exactement ça.
Question subsidiaire: serait-il possible d'appliquer cette mise en page à toutes les feuilles du classeur (workbook?) sans passer par le "pinceau"?
Cordialement, Pierre F.
Tu utilises cet événement du ThisWorkbook :
Toutes les feuilles de calcul seront soumis à la même
procédure !
'-----------------------------------------
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c As Range
If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then
For Each c In Target
If InStr(1, c.Value, "bolo", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 39
ElseIf InStr(1, c.Value, "mama", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 36
ElseIf InStr(1, c.Value, "bien", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 37
ElseIf InStr(1, c.Value, "cc popo", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 35
ElseIf InStr(1, c.Value, "cc papa", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 38
Else
c.Offset(0, 0).Interior.ColorIndex = 0
End If
Next
End If
End Sub
'-----------------------------------------
"Pierre F." <pfornerodNO@SPAMhotmail.ch> a écrit dans le message de groupe de discussion :
52757$4a897dd5$55da2ee3$30825@news.hispeed.ch...
MichDenis a écrit :
Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then
For Each c In Target
If InStr(1, c.Value, "bolo", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 39
ElseIf InStr(1, c.Value, "mama", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 36
ElseIf InStr(1, c.Value, "bien", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 37
ElseIf InStr(1, c.Value, "cc popo", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 35
ElseIf InStr(1, c.Value, "cc papa", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 38
Else
c.Offset(0, 0).Interior.ColorIndex = 0
End If
Next
End If
End Sub
Impeccable!! Merci! C'est exactement ça.
Question subsidiaire: serait-il possible d'appliquer cette mise en page
à toutes les feuilles du classeur (workbook?) sans passer par le "pinceau"?
Toutes les feuilles de calcul seront soumis à la même procédure ! '----------------------------------------- Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c As Range If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target If InStr(1, c.Value, "bolo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 39 ElseIf InStr(1, c.Value, "mama", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 36 ElseIf InStr(1, c.Value, "bien", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 37 ElseIf InStr(1, c.Value, "cc popo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 35 ElseIf InStr(1, c.Value, "cc papa", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 38 Else c.Offset(0, 0).Interior.ColorIndex = 0 End If Next End If End Sub '-----------------------------------------
"Pierre F." a écrit dans le message de groupe de discussion : 52757$4a897dd5$55da2ee3$ MichDenis a écrit :
Private Sub Worksheet_change(ByVal Target As Range) Dim c As Range If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target If InStr(1, c.Value, "bolo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 39 ElseIf InStr(1, c.Value, "mama", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 36 ElseIf InStr(1, c.Value, "bien", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 37 ElseIf InStr(1, c.Value, "cc popo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 35 ElseIf InStr(1, c.Value, "cc papa", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 38 Else c.Offset(0, 0).Interior.ColorIndex = 0 End If Next End If End Sub
Impeccable!! Merci! C'est exactement ça.
Question subsidiaire: serait-il possible d'appliquer cette mise en page à toutes les feuilles du classeur (workbook?) sans passer par le "pinceau"?
Cordialement, Pierre F.
Pierre F.
MichDenis a écrit :
Tu utilises cet événement du ThisWorkbook :
Toutes les feuilles de calcul seront soumis à la même procédure ! '----------------------------------------- Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Ra nge)
Dim c As Range If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target If InStr(1, c.Value, "bolo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 39 ElseIf InStr(1, c.Value, "mama", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 36 ElseIf InStr(1, c.Value, "bien", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 37 ElseIf InStr(1, c.Value, "cc popo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 35 ElseIf InStr(1, c.Value, "cc papa", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 38 Else c.Offset(0, 0).Interior.ColorIndex = 0 End If Next End If End Sub '-----------------------------------------
Génial; j'avais essayé un simple copier-coller et changé le sheet p ar book... mais c'était pas si simple :-)
Mille mercis.
Cordialement, Pierre F.
MichDenis a écrit :
Tu utilises cet événement du ThisWorkbook :
Toutes les feuilles de calcul seront soumis à la même
procédure !
'-----------------------------------------
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Ra nge)
Dim c As Range
If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then
For Each c In Target
If InStr(1, c.Value, "bolo", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 39
ElseIf InStr(1, c.Value, "mama", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 36
ElseIf InStr(1, c.Value, "bien", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 37
ElseIf InStr(1, c.Value, "cc popo", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 35
ElseIf InStr(1, c.Value, "cc papa", vbTextCompare) > 0 Then
c.Offset(0, 0).Interior.ColorIndex = 38
Else
c.Offset(0, 0).Interior.ColorIndex = 0
End If
Next
End If
End Sub
'-----------------------------------------
Génial; j'avais essayé un simple copier-coller et changé le sheet p ar
book... mais c'était pas si simple :-)
Toutes les feuilles de calcul seront soumis à la même procédure ! '----------------------------------------- Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Ra nge)
Dim c As Range If Not Intersect(Target.Cells, Range("A6:A100")) Is Nothing Then For Each c In Target If InStr(1, c.Value, "bolo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 39 ElseIf InStr(1, c.Value, "mama", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 36 ElseIf InStr(1, c.Value, "bien", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 37 ElseIf InStr(1, c.Value, "cc popo", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 35 ElseIf InStr(1, c.Value, "cc papa", vbTextCompare) > 0 Then c.Offset(0, 0).Interior.ColorIndex = 38 Else c.Offset(0, 0).Interior.ColorIndex = 0 End If Next End If End Sub '-----------------------------------------
Génial; j'avais essayé un simple copier-coller et changé le sheet p ar book... mais c'était pas si simple :-)
