MFC et jocker (*)

Le
Pierre F.
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 "Bolo=
s".

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.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichDenis
Le #19942461
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." 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
Le #19942451
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." 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.
garnote
Le #19942441
Le Offset(0,0) me semble superfllu. Non ?

Serge
Pierre F.
Le #19942581
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"?

Cordialement,
Pierre F.
Pierre F.
Le #19942571
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.
Pierre F.
Le #19942551
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.
MichDenis
Le #19942731
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." 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.
Le #19942901
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.
Publicité
Poster une réponse
Anonyme