Forums Applications Microsoft Office Excel

MFC et jocker (*)

Le lundi 17 Août 2009 à 16:54

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.

Questions / Réponses high-tech

Poser une question

Vidéos High-Tech et Jeu Vidéo

Castlevania Lords of Shadow 2 : trailer E3
Konami vient de révéler le développement de Castlevania : Lords of Shadow 2 avec une...
Tomb Raider : trailer E3 2012
Square Enix dévoile une nouvelle vidéo de son prochain Tomb Raider. Quelques images...

Plus de vidéos

Téléchargements

Utilitaires

DotMouse : changer de curseur de souris
Si vous voulez modifier votre curseur de souris avec de jolis dessins, alors essayez...
Utilitaires

ArtCursors : personnaliser le curseur de sa souris
Personnalisez votre curseur à l’aide du programme ArtCursors.

Plus de téléchargements

Suivez GNT

Vos réponses Page 1 / 2

Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !

Trier par : date / pertinence

MichDenis

Le 17/08/2009 à 17:29 #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.

-1 Répondre en citant

Mima

Le 17/08/2009 à 17:35 #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.

-1 Répondre en citant

garnote

Le 17/08/2009 à 17:45 #19942441

Le Offset(0,0) me semble superfllu. Non ?

Serge

-1 Répondre en citant

Pierre F.

Le 17/08/2009 à 17:57 #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.

-1 Répondre en citant

Pierre F.

Le 17/08/2009 à 17:59 #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.

-1 Répondre en citant

Publicité

‹ 12 › »

Suivre les réponses

Poster une réponse