[VBA] XL2003 - couleur fond venant d'une autre feuille

Le
Congelator
Bonjour à toutes et à tous, j'ai encore besoin de vous. Voilà mon blème :
Un tableau de service avec 1 feuille par mois. Quand l'utilisateur tape "C"
(p.ex.pour congé), le fond de la cellule passe en bleu via une macro. MAIS
tous les services n'utilisent pas les mêmes codes (C, CO, 2) pour une même
affectation ni la même couleur de fond je vais les taper !!! Donc
j'aimerais avoir une feuille "configuration", en ligne 2 le code qu'ils
utilisent et en 3 la couleur qu'ils veulent. Ensuite - et c'est là que j'ai
besoin de vous - faire appel à ces 2 conditions pour que ça fonctionne de
manière automatique.

Merci d'avance.
Voici déjà mon code actuel :

Public Sub Couleurs(ByVal Target As Range)
Dim c As Range
Dim congé As Integer ' 1er essai pas concluant
congé = Sheets("configuration").Range("B2").Value
If Not Intersect(Target.Cells, Range("B4:AF60")) Is Nothing Then
For Each c In Target
Select Case c.Value
'Case "congé": c.Font.ColorIndex = 0:
c.Interior.ColorIndex =
Sheets("configuration").Range("B3").Interior.ColorIndex '1er essai pas
concluant
Case "c": c.Font.ColorIndex = 0: c.Interior.ColorIndex =
37
Case "c/": c.Font.ColorIndex = 0: c.Interior.ColorIndex
= 37
Case " /c": c.Font.ColorIndex = 0: c.Interior.ColorIndex
= 37
Case "cs/": c.Font.ColorIndex = 2: c.Interior.ColorIndex
= 5
Case "cs": c.Font.ColorIndex = 2: c.Interior.ColorIndex
= 5
Case " /cs": c.Font.ColorIndex = 2:
c.Interior.ColorIndex = 5
Case "v": c.Font.ColorIndex = 0: c.Interior.ColorIndex = 4
Case "v/": c.Font.ColorIndex = 0: c.Interior.ColorIndex
= 4
Case " /v": c.Font.ColorIndex = 0: c.Interior.ColorIndex
= 4
Case "m": c.Font.ColorIndex = 2: c.Interior.ColorIndex = 3
Case "m/": c.Font.ColorIndex = 2: c.Interior.ColorIndex
= 3
Case " /m": c.Font.ColorIndex = 2: c.Interior.ColorIndex
= 3
Case "D/c": c.Font.ColorIndex = 0: c.Interior.ColorIndex
= 37
Case "lrh": c.Font.ColorIndex = 0: c.Interior.ColorIndex
= 40
Case " /lrh": c.Font.ColorIndex = 0:
c.Interior.ColorIndex = 40
Case "lrh/": c.Font.ColorIndex = 0:
c.Interior.ColorIndex = 40
'Case "m/": c.Font.ColorIndex = 9: c.Interior.ColorIndex
= 10

Case Else: c.Font.ColorIndex = xlAutomatic:
c.Interior.ColorIndex = xlNone
End Select
Next
End If

--
Céd / Lausanne
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
Jacky
Le #20089711
Bonsoir,
Une idée a creuser peut-être
Un base de donnée avec toutes les Abréviations avec leurs couleurs dans une
feuille.
Un recherche avec index / equiv plus la copie selon que la valeur saisie se
trouve dans cette base
'--------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If IsError(Application.Match(Target, [code], 0)) Then
Target.Interior.ColorIndex = 0
Else
Application.Index([code], Application.Match(Target, [code], 0)).Copy
Target
End If
Application.EnableEvents = True
End Sub
'---------------------
Voir ici un debut
http://www.cijoint.fr/cjlink.php?file=cj200909/cijGnfSwBA.xls
--
Salutations
JJ


"Congelator" news:
Bonjour à toutes et à tous, j'ai encore besoin de vous. Voilà mon blème :
Un tableau de service avec 1 feuille par mois. Quand l'utilisateur tape
"C"
(p.ex.pour congé), le fond de la cellule passe en bleu via une macro.
MAIS...
tous les services n'utilisent pas les mêmes codes (C, CO, 2) pour une même
affectation ni la même couleur de fond... je vais les taper !!! Donc
j'aimerais avoir une feuille "configuration", en ligne 2 le code qu'ils
utilisent et en 3 la couleur qu'ils veulent. Ensuite - et c'est là que
j'ai
besoin de vous - faire appel à ces 2 conditions pour que ça fonctionne de
manière automatique.

Merci d'avance.
Voici déjà mon code actuel :

Public Sub Couleurs(ByVal Target As Range)
Dim c As Range
Dim congé As Integer ' 1er essai pas concluant
congé = Sheets("configuration").Range("B2").Value
If Not Intersect(Target.Cells, Range("B4:AF60")) Is Nothing Then
For Each c In Target
Select Case c.Value
'Case "congé": c.Font.ColorIndex = 0:
c.Interior.ColorIndex > Sheets("configuration").Range("B3").Interior.ColorIndex '1er essai pas
concluant
Case "c": c.Font.ColorIndex = 0: c.Interior.ColorIndex
> 37
Case "c/": c.Font.ColorIndex = 0: c.Interior.ColorIndex
= 37
Case " /c": c.Font.ColorIndex = 0:
c.Interior.ColorIndex
= 37
Case "cs/": c.Font.ColorIndex = 2:
c.Interior.ColorIndex
= 5
Case "cs": c.Font.ColorIndex = 2: c.Interior.ColorIndex
= 5
Case " /cs": c.Font.ColorIndex = 2:
c.Interior.ColorIndex = 5
Case "v": c.Font.ColorIndex = 0: c.Interior.ColorIndex
= 4
Case "v/": c.Font.ColorIndex = 0: c.Interior.ColorIndex
= 4
Case " /v": c.Font.ColorIndex = 0:
c.Interior.ColorIndex
= 4
Case "m": c.Font.ColorIndex = 2: c.Interior.ColorIndex
= 3
Case "m/": c.Font.ColorIndex = 2: c.Interior.ColorIndex
= 3
Case " /m": c.Font.ColorIndex = 2:
c.Interior.ColorIndex
= 3
Case "D/c": c.Font.ColorIndex = 0:
c.Interior.ColorIndex
= 37
Case "lrh": c.Font.ColorIndex = 0:
c.Interior.ColorIndex
= 40
Case " /lrh": c.Font.ColorIndex = 0:
c.Interior.ColorIndex = 40
Case "lrh/": c.Font.ColorIndex = 0:
c.Interior.ColorIndex = 40
'Case "m/": c.Font.ColorIndex = 9:
c.Interior.ColorIndex
= 10

Case Else: c.Font.ColorIndex = xlAutomatic:
c.Interior.ColorIndex = xlNone
End Select
Next
End If

--
Céd / Lausanne


Congelator
Le #20092341
Salut Jacky,
C'est GE-NIAL !!! Je ne comprends rien du tout au code (mes connaissances
VBA sont très limitées) mais CA MAAAARCHE !!
Est-ce que tu pourrais encore me dire comment et ou dans ton code je peux
limiter ces modifications à la plage B4:AF60 car avec ton code, si une
andouille va taper un des codes en dehors du tableau (bien qu'il doive le
faire à l'intérieur...), ça applique la mise en forme et ça risque de poser
des problèmes... Merci d'avance
--
Céd / Lausanne


"Jacky" a écrit :

Bonsoir,
Une idée a creuser peut-être
Un base de donnée avec toutes les Abréviations avec leurs couleurs dans une
feuille.
Un recherche avec index / equiv plus la copie selon que la valeur saisie se
trouve dans cette base
'--------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If IsError(Application.Match(Target, [code], 0)) Then
Target.Interior.ColorIndex = 0
Else
Application.Index([code], Application.Match(Target, [code], 0)).Copy
Target
End If
Application.EnableEvents = True
End Sub
'---------------------
Voir ici un debut
http://www.cijoint.fr/cjlink.php?file=cj200909/cijGnfSwBA.xls
--
Salutations
JJ


"Congelator" news:
> Bonjour à toutes et à tous, j'ai encore besoin de vous. Voilà mon blème :
> Un tableau de service avec 1 feuille par mois. Quand l'utilisateur tape
> "C"
> (p.ex.pour congé), le fond de la cellule passe en bleu via une macro.
> MAIS...
> tous les services n'utilisent pas les mêmes codes (C, CO, 2) pour une même
> affectation ni la même couleur de fond... je vais les taper !!! Donc
> j'aimerais avoir une feuille "configuration", en ligne 2 le code qu'ils
> utilisent et en 3 la couleur qu'ils veulent. Ensuite - et c'est là que
> j'ai
> besoin de vous - faire appel à ces 2 conditions pour que ça fonctionne de
> manière automatique.
>
> Merci d'avance.
> Voici déjà mon code actuel :
>
> Public Sub Couleurs(ByVal Target As Range)
> Dim c As Range
> Dim congé As Integer ' 1er essai pas concluant
> congé = Sheets("configuration").Range("B2").Value
> If Not Intersect(Target.Cells, Range("B4:AF60")) Is Nothing Then
> For Each c In Target
> Select Case c.Value
> 'Case "congé": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex > > Sheets("configuration").Range("B3").Interior.ColorIndex '1er essai pas
> concluant
> Case "c": c.Font.ColorIndex = 0: c.Interior.ColorIndex
> > > 37
> Case "c/": c.Font.ColorIndex = 0: c.Interior.ColorIndex
> = 37
> Case " /c": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex
> = 37
> Case "cs/": c.Font.ColorIndex = 2:
> c.Interior.ColorIndex
> = 5
> Case "cs": c.Font.ColorIndex = 2: c.Interior.ColorIndex
> = 5
> Case " /cs": c.Font.ColorIndex = 2:
> c.Interior.ColorIndex = 5
> Case "v": c.Font.ColorIndex = 0: c.Interior.ColorIndex
> = 4
> Case "v/": c.Font.ColorIndex = 0: c.Interior.ColorIndex
> = 4
> Case " /v": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex
> = 4
> Case "m": c.Font.ColorIndex = 2: c.Interior.ColorIndex
> = 3
> Case "m/": c.Font.ColorIndex = 2: c.Interior.ColorIndex
> = 3
> Case " /m": c.Font.ColorIndex = 2:
> c.Interior.ColorIndex
> = 3
> Case "D/c": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex
> = 37
> Case "lrh": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex
> = 40
> Case " /lrh": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex = 40
> Case "lrh/": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex = 40
> 'Case "m/": c.Font.ColorIndex = 9:
> c.Interior.ColorIndex
> = 10
>
> Case Else: c.Font.ColorIndex = xlAutomatic:
> c.Interior.ColorIndex = xlNone
> End Select
> Next
> End If
>
> --
> Céd / Lausanne







Jacky
Le #20092651
Re..
...dans ton code je peux limiter ces modifications à la plage B4:AF60...


'------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [B4:AF60]) Is Nothing Then
Application.EnableEvents = False
If IsError(Application.Match(Target, [code], 0)) Then
Target.Interior.ColorIndex = 0
Else
Application.Index([code], Application.Match(Target, [code], 0)).Copy
Target
End If
End If
Application.EnableEvents = True
End Sub
'--------------
PS : Il serait utile/possible de mettre dans le plage [B4:AF60] une liste de
validation ayant comme source les abréviations.

Sélection de [B4:AF60]
Donnée/validation
Autoriser= Liste
Source: =Code

Evidemment il faudra compléter la liste nommée "Code"
--
Salutations
JJ


"Congelator" news:
Salut Jacky,
C'est GE-NIAL !!! Je ne comprends rien du tout au code (mes connaissances
VBA sont très limitées) mais CA MAAAARCHE !!
Est-ce que tu pourrais encore me dire comment et ou dans ton code je peux
limiter ces modifications à la plage B4:AF60 car avec ton code, si une
andouille va taper un des codes en dehors du tableau (bien qu'il doive le
faire à l'intérieur...), ça applique la mise en forme et ça risque de
poser
des problèmes... Merci d'avance
--
Céd / Lausanne


"Jacky" a écrit :

Bonsoir,
Une idée a creuser peut-être
Un base de donnée avec toutes les Abréviations avec leurs couleurs dans
une
feuille.
Un recherche avec index / equiv plus la copie selon que la valeur saisie
se
trouve dans cette base
'--------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If IsError(Application.Match(Target, [code], 0)) Then
Target.Interior.ColorIndex = 0
Else
Application.Index([code], Application.Match(Target, [code], 0)).Copy
Target
End If
Application.EnableEvents = True
End Sub
'---------------------
Voir ici un debut
http://www.cijoint.fr/cjlink.php?file=cj200909/cijGnfSwBA.xls
--
Salutations
JJ


"Congelator" de
news:
> Bonjour à toutes et à tous, j'ai encore besoin de vous. Voilà mon blème
> :
> Un tableau de service avec 1 feuille par mois. Quand l'utilisateur tape
> "C"
> (p.ex.pour congé), le fond de la cellule passe en bleu via une macro.
> MAIS...
> tous les services n'utilisent pas les mêmes codes (C, CO, 2) pour une
> même
> affectation ni la même couleur de fond... je vais les taper !!! Donc
> j'aimerais avoir une feuille "configuration", en ligne 2 le code qu'ils
> utilisent et en 3 la couleur qu'ils veulent. Ensuite - et c'est là que
> j'ai
> besoin de vous - faire appel à ces 2 conditions pour que ça fonctionne
> de
> manière automatique.
>
> Merci d'avance.
> Voici déjà mon code actuel :
>
> Public Sub Couleurs(ByVal Target As Range)
> Dim c As Range
> Dim congé As Integer ' 1er essai pas concluant
> congé = Sheets("configuration").Range("B2").Value
> If Not Intersect(Target.Cells, Range("B4:AF60")) Is Nothing Then
> For Each c In Target
> Select Case c.Value
> 'Case "congé": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex >> > Sheets("configuration").Range("B3").Interior.ColorIndex '1er essai pas
> concluant
> Case "c": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex
> >> > 37
> Case "c/": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex
> = 37
> Case " /c": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex
> = 37
> Case "cs/": c.Font.ColorIndex = 2:
> c.Interior.ColorIndex
> = 5
> Case "cs": c.Font.ColorIndex = 2:
> c.Interior.ColorIndex
> = 5
> Case " /cs": c.Font.ColorIndex = 2:
> c.Interior.ColorIndex = 5
> Case "v": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex
> = 4
> Case "v/": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex
> = 4
> Case " /v": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex
> = 4
> Case "m": c.Font.ColorIndex = 2:
> c.Interior.ColorIndex
> = 3
> Case "m/": c.Font.ColorIndex = 2:
> c.Interior.ColorIndex
> = 3
> Case " /m": c.Font.ColorIndex = 2:
> c.Interior.ColorIndex
> = 3
> Case "D/c": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex
> = 37
> Case "lrh": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex
> = 40
> Case " /lrh": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex = 40
> Case "lrh/": c.Font.ColorIndex = 0:
> c.Interior.ColorIndex = 40
> 'Case "m/": c.Font.ColorIndex = 9:
> c.Interior.ColorIndex
> = 10
>
> Case Else: c.Font.ColorIndex = xlAutomatic:
> c.Interior.ColorIndex = xlNone
> End Select
> Next
> End If
>
> --
> Céd / Lausanne









Congelator
Le #20093431
re...

t'es un chef ! tout fonctionne à merveille. Pour ce qui est des listes de
validation, j'y avais pensé mais les cellules sont trop étroites, c'est moins
pratique.

Encore MERCI !
--
Céd / Lausanne


"Jacky" a écrit :

Re..
>...dans ton code je peux limiter ces modifications à la plage B4:AF60...
'------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [B4:AF60]) Is Nothing Then
Application.EnableEvents = False
If IsError(Application.Match(Target, [code], 0)) Then
Target.Interior.ColorIndex = 0
Else
Application.Index([code], Application.Match(Target, [code], 0)).Copy
Target
End If
End If
Application.EnableEvents = True
End Sub
'--------------
PS : Il serait utile/possible de mettre dans le plage [B4:AF60] une liste de
validation ayant comme source les abréviations.

Sélection de [B4:AF60]
Donnée/validation
Autoriser= Liste
Source: =Code

Evidemment il faudra compléter la liste nommée "Code"
--
Salutations
JJ


"Congelator" news:
> Salut Jacky,
> C'est GE-NIAL !!! Je ne comprends rien du tout au code (mes connaissances
> VBA sont très limitées) mais CA MAAAARCHE !!
> Est-ce que tu pourrais encore me dire comment et ou dans ton code je peux
> limiter ces modifications à la plage B4:AF60 car avec ton code, si une
> andouille va taper un des codes en dehors du tableau (bien qu'il doive le
> faire à l'intérieur...), ça applique la mise en forme et ça risque de
> poser
> des problèmes... Merci d'avance
> --
> Céd / Lausanne
>
>
> "Jacky" a écrit :
>
>> Bonsoir,
>> Une idée a creuser peut-être
>> Un base de donnée avec toutes les Abréviations avec leurs couleurs dans
>> une
>> feuille.
>> Un recherche avec index / equiv plus la copie selon que la valeur saisie
>> se
>> trouve dans cette base
>> '--------------
>> Private Sub Worksheet_Change(ByVal Target As Range)
>> If Target.Count > 1 Then Exit Sub
>> Application.EnableEvents = False
>> If IsError(Application.Match(Target, [code], 0)) Then
>> Target.Interior.ColorIndex = 0
>> Else
>> Application.Index([code], Application.Match(Target, [code], 0)).Copy
>> Target
>> End If
>> Application.EnableEvents = True
>> End Sub
>> '---------------------
>> Voir ici un debut
>> http://www.cijoint.fr/cjlink.php?file=cj200909/cijGnfSwBA.xls
>> --
>> Salutations
>> JJ
>>
>>
>> "Congelator" >> de
>> news:
>> > Bonjour à toutes et à tous, j'ai encore besoin de vous. Voilà mon blème
>> > :
>> > Un tableau de service avec 1 feuille par mois. Quand l'utilisateur tape
>> > "C"
>> > (p.ex.pour congé), le fond de la cellule passe en bleu via une macro.
>> > MAIS...
>> > tous les services n'utilisent pas les mêmes codes (C, CO, 2) pour une
>> > même
>> > affectation ni la même couleur de fond... je vais les taper !!! Donc
>> > j'aimerais avoir une feuille "configuration", en ligne 2 le code qu'ils
>> > utilisent et en 3 la couleur qu'ils veulent. Ensuite - et c'est là que
>> > j'ai
>> > besoin de vous - faire appel à ces 2 conditions pour que ça fonctionne
>> > de
>> > manière automatique.
>> >
>> > Merci d'avance.
>> > Voici déjà mon code actuel :
>> >
>> > Public Sub Couleurs(ByVal Target As Range)
>> > Dim c As Range
>> > Dim congé As Integer ' 1er essai pas concluant
>> > congé = Sheets("configuration").Range("B2").Value
>> > If Not Intersect(Target.Cells, Range("B4:AF60")) Is Nothing Then
>> > For Each c In Target
>> > Select Case c.Value
>> > 'Case "congé": c.Font.ColorIndex = 0:
>> > c.Interior.ColorIndex > >> > Sheets("configuration").Range("B3").Interior.ColorIndex '1er essai pas
>> > concluant
>> > Case "c": c.Font.ColorIndex = 0:
>> > c.Interior.ColorIndex
>> > > >> > 37
>> > Case "c/": c.Font.ColorIndex = 0:
>> > c.Interior.ColorIndex
>> > = 37
>> > Case " /c": c.Font.ColorIndex = 0:
>> > c.Interior.ColorIndex
>> > = 37
>> > Case "cs/": c.Font.ColorIndex = 2:
>> > c.Interior.ColorIndex
>> > = 5
>> > Case "cs": c.Font.ColorIndex = 2:
>> > c.Interior.ColorIndex
>> > = 5
>> > Case " /cs": c.Font.ColorIndex = 2:
>> > c.Interior.ColorIndex = 5
>> > Case "v": c.Font.ColorIndex = 0:
>> > c.Interior.ColorIndex
>> > = 4
>> > Case "v/": c.Font.ColorIndex = 0:
>> > c.Interior.ColorIndex
>> > = 4
>> > Case " /v": c.Font.ColorIndex = 0:
>> > c.Interior.ColorIndex
>> > = 4
>> > Case "m": c.Font.ColorIndex = 2:
>> > c.Interior.ColorIndex
>> > = 3
>> > Case "m/": c.Font.ColorIndex = 2:
>> > c.Interior.ColorIndex
>> > = 3
>> > Case " /m": c.Font.ColorIndex = 2:
>> > c.Interior.ColorIndex
>> > = 3
>> > Case "D/c": c.Font.ColorIndex = 0:
>> > c.Interior.ColorIndex
>> > = 37
>> > Case "lrh": c.Font.ColorIndex = 0:
>> > c.Interior.ColorIndex
>> > = 40
>> > Case " /lrh": c.Font.ColorIndex = 0:
>> > c.Interior.ColorIndex = 40
>> > Case "lrh/": c.Font.ColorIndex = 0:
>> > c.Interior.ColorIndex = 40
>> > 'Case "m/": c.Font.ColorIndex = 9:
>> > c.Interior.ColorIndex
>> > = 10
>> >
>> > Case Else: c.Font.ColorIndex = xlAutomatic:
>> > c.Interior.ColorIndex = xlNone
>> > End Select
>> > Next
>> > End If
>> >
>> > --
>> > Céd / Lausanne
>>
>>
>>
>>
>>





Publicité
Poster une réponse
Anonyme