Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel [VBA] XL2003 - couleur fond venant d'une autre feuille

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

4 réponses
Avatar
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
Signaler un problème avec ce contenu

4 réponses

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
Jacky
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" <congelator(a_effacer)@hotmail.com> a écrit dans le message 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


Avatar
Congelator
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" <congelator(a_effacer)@hotmail.com> a écrit dans le message 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







Avatar
Jacky
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" <congelator(a_effacer)@hotmail.com> a écrit dans le message de
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" <congelator(a_effacer)@hotmail.com> a écrit dans le message
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









Avatar
Congelator
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" <congelator(a_effacer)@hotmail.com> a écrit dans le message de
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" <congelator(a_effacer)@hotmail.com> a écrit dans le message
>> 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
>>
>>
>>
>>
>>