MFC avec 6 conditions

Essaie :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatV], 1) 'FormatV au lieu de Vent
If Not IsError(p) Then
Range("FormatV")(p).Copy 'remplace :
'Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
'remplace :
'Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Daniel

Ok ci-joint :
http://www.cijoint.fr/cjlink.php?file=cj201002/cijFauydCv.xls
Guy

"Daniel.C" a écrit dans le message de news:

Peux-tu mettre ton classeur sur cjoint.com ?
Comme ça, cà a l'air bon...
Daniel

Bonjour Daniel.
J'arrive à utiliser cet exemple et à l'adaper.
Par contre, je souhaite avoir 2 zones différentes avec 2 format
différents
J'ai modifié le code, mais je pense qu'il y a autre chose à faire, ça
fonctionne pour l'un mais pas pour l'autre.
Voici le code modifié à ma manière.
C'est les deux même, mais en changeant simplement le non des zones.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [Vent], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count =
1 Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

"Daniel.C" a écrit dans le message de news:

Bonjour Guy.
C'est un exemple de changement de couleur quand on change de valeur en
colonne B. La macro est listée sur la même feuille.
Cordialement.
Daniel

Re,
Bon.ça y est j'arrive à comprendre le modèle sans la 1ère feuille ?
A quoi sert la 1ère feuille "MFCCouleur" ?
Guy

"Modeste" a écrit dans le message de news:

Bonsour® Guy85 avec ferveur ;o))) vous nous disiez :

Je ne comprends pas.

"JB" a écrit dans le message de news:
http://boisgontierjacques.free.fr/fichiers/MFC/MFCZoneNum.xls

il te faut adapter la plage "CouleursNb" dans l'onglet Couleurs selon
tes definitions

il y a egalement cette possibilité :
http://www.xldynamic.com/source/xld.CFPlus.Download.html

sinon passer à Excel 7 !!!!

On 5 fév, 09:26, "Guy85" wrote:

Est-il possible d'avoir 6 MFC différentes ?
J'ai bien regardé plusieurs exemples, mais c'était toujours avec
une
valeur
déjà définie,
mais là je souhaiterais avec une condition.
1) <0 (Jeu de couleur, Police gras blanc).
2) de 0 à 12 (Jeu de couleur, Police gras Auto).
3) de 13 à 18 (Bleu glacier, Police gras Auto).
4) de 19 à 25 (Vert clair, Police gras Auto).
5) de 16 à 30 (Brun, Police gras Auto).
6) >30 (Rouge, Police gras jaune).

Bonjour JB
Je ne comprends pas.
Guy
"JB" a écrit dans le message de news:

Bonjour,

http://boisgontierjacques.free.fr/fichiers/MFC/MFCZoneNum.xls

JB

On 5 fév, 09:26, "Guy85" wrote:



> Bonjour,
> Est-il possible d'avoir 6 MFC différentes ?
> J'ai bien regardé plusieurs exemples, mais c'était toujours avec un e
> valeur
> déjà définie,
> mais là je souhaiterais avec une condition.
> 1) <0 (Jeu de couleur, Police gras blanc).
> 2) de 0 à 12 (Jeu de couleur, Police gras Auto).
> 3) de 13 à 18 (Bleu glacier, Police gras Auto).
> 4) de 19 à 25 (Vert clair, Police gras Auto).
> 5) de 16 à 30 (Brun, Police gras Auto).
> 6) >30 (Rouge, Police gras jaune).
> Merci de votre aide
> Cordialement
> Guy- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -

Essaie :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatV], 1) 'FormatV au lieu de Vent
If Not IsError(p) Then
Range("FormatV")(p).Copy 'remplace :
'Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
'remplace :
'Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Daniel

Ok ci-joint :
http://www.cijoint.fr/cjlink.php?file=cj201002/cijFauydCv.xls
Guy

"Daniel.C" a écrit dans le message de news:

Peux-tu mettre ton classeur sur cjoint.com ?
Comme ça, cà a l'air bon...
Daniel

Bonjour Daniel.
J'arrive à utiliser cet exemple et à l'adaper.
Par contre, je souhaite avoir 2 zones différentes avec 2 format
différents
J'ai modifié le code, mais je pense qu'il y a autre chose à faire, ça
fonctionne pour l'un mais pas pour l'autre.
Voici le code modifié à ma manière.
C'est les deux même, mais en changeant simplement le non des zones.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [Vent], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count =
1 Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

"Daniel.C" a écrit dans le message de news:

Bonjour Guy.
C'est un exemple de changement de couleur quand on change de valeur en
colonne B. La macro est listée sur la même feuille.
Cordialement.
Daniel

Re,
Bon.ça y est j'arrive à comprendre le modèle sans la 1ère feuille ?
A quoi sert la 1ère feuille "MFCCouleur" ?
Guy

"Modeste" a écrit dans le message de news:

Bonsour® Guy85 avec ferveur ;o))) vous nous disiez :

Je ne comprends pas.

"JB" a écrit dans le message de news:
http://boisgontierjacques.free.fr/fichiers/MFC/MFCZoneNum.xls

il te faut adapter la plage "CouleursNb" dans l'onglet Couleurs selon
tes definitions

il y a egalement cette possibilité :
http://www.xldynamic.com/source/xld.CFPlus.Download.html

sinon passer à Excel 7 !!!!

On 5 fév, 09:26, "Guy85" wrote:

Est-il possible d'avoir 6 MFC différentes ?
J'ai bien regardé plusieurs exemples, mais c'était toujours avec
une
valeur
déjà définie,
mais là je souhaiterais avec une condition.
1) <0 (Jeu de couleur, Police gras blanc).
2) de 0 à 12 (Jeu de couleur, Police gras Auto).
3) de 13 à 18 (Bleu glacier, Police gras Auto).
4) de 19 à 25 (Vert clair, Police gras Auto).
5) de 16 à 30 (Brun, Police gras Auto).
6) >30 (Rouge, Police gras jaune).

Bonsoir,
Je fais encore appel à toi, car avec le nouveau code que je mets dans un
autre classeur,
il fonctionne si je n'ai que ce code, il y da déjà un code dans cette feuille
et il a la même 1ère ligne de code.

Private Sub Worksheet_Change(ByVal Target As Range)

Même si j'enlève cette ligne et le "End sub" du 1er ça ne fonctionne plus.
Je pense qu'il doit y avoir un moyen de pouvoir faire fonctionner les deux ?
Mais le quel ?

Cordialement
Guy

"Daniel.C" a écrit dans le message de news:

Essaie :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatV], 1) 'FormatV au lieu de Vent
If Not IsError(p) Then
Range("FormatV")(p).Copy 'remplace :
'Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
'remplace :
'Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Daniel

Ok ci-joint :
http://www.cijoint.fr/cjlink.php?file=cj201002/cijFauydCv.xls
Guy

"Daniel.C" a écrit dans le message de news:

Peux-tu mettre ton classeur sur cjoint.com ?
Comme ça, cà a l'air bon...
Daniel

Bonjour Daniel.
J'arrive à utiliser cet exemple et à l'adaper.
Par contre, je souhaite avoir 2 zones différentes avec 2 format
différents
J'ai modifié le code, mais je pense qu'il y a autre chose à faire, ça
fonctionne pour l'un mais pas pour l'autre.
Voici le code modifié à ma manière.
C'est les deux même, mais en changeant simplement le non des zones.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [Vent], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

"Daniel.C" a écrit dans le message de news:

Bonjour Guy.
C'est un exemple de changement de couleur quand on change de valeur en
colonne B. La macro est listée sur la même feuille.
Cordialement.
Daniel

Re,
Bon.ça y est j'arrive à comprendre le modèle sans la 1ère feuille ?
A quoi sert la 1ère feuille "MFCCouleur" ?
Guy

"Modeste" a écrit dans le message de news:

Bonsour® Guy85 avec ferveur ;o))) vous nous disiez :

Je ne comprends pas.

"JB" a écrit dans le message de news:
http://boisgontierjacques.free.fr/fichiers/MFC/MFCZoneNum.xls

il te faut adapter la plage "CouleursNb" dans l'onglet Couleurs selon
tes definitions

il y a egalement cette possibilité :
http://www.xldynamic.com/source/xld.CFPlus.Download.html

sinon passer à Excel 7 !!!!

On 5 fév, 09:26, "Guy85" wrote:

Est-il possible d'avoir 6 MFC différentes ?
J'ai bien regardé plusieurs exemples, mais c'était toujours avec une
valeur
déjà définie,
mais là je souhaiterais avec une condition.
1) <0 (Jeu de couleur, Police gras blanc).
2) de 0 à 12 (Jeu de couleur, Police gras Auto).
3) de 13 à 18 (Bleu glacier, Police gras Auto).
4) de 19 à 25 (Vert clair, Police gras Auto).
5) de 16 à 30 (Brun, Police gras Auto).
6) >30 (Rouge, Police gras jaune).

Poste les deux macros.
Daniel

Bonsoir,
Je fais encore appel à toi, car avec le nouveau code que je mets dans un
autre classeur,
il fonctionne si je n'ai que ce code, il y da déjà un code dans cette
feuille et il a la même 1ère ligne de code.

Private Sub Worksheet_Change(ByVal Target As Range)

Même si j'enlève cette ligne et le "End sub" du 1er ça ne fonctionne
plus.
Je pense qu'il doit y avoir un moyen de pouvoir faire fonctionner les
deux ?
Mais le quel ?

Cordialement
Guy

"Daniel.C" a écrit dans le message de news:

Essaie :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatV], 1) 'FormatV au lieu de Vent
If Not IsError(p) Then
Range("FormatV")(p).Copy 'remplace :
'Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
'remplace :
'Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Daniel

Ok ci-joint :
http://www.cijoint.fr/cjlink.php?file=cj201002/cijFauydCv.xls
Guy

"Daniel.C" a écrit dans le message de news:

Peux-tu mettre ton classeur sur cjoint.com ?
Comme ça, cà a l'air bon...
Daniel

Bonjour Daniel.
J'arrive à utiliser cet exemple et à l'adaper.
Par contre, je souhaite avoir 2 zones différentes avec 2 format
différents
J'ai modifié le code, mais je pense qu'il y a autre chose à faire, ça
fonctionne pour l'un mais pas pour l'autre.
Voici le code modifié à ma manière.
C'est les deux même, mais en changeant simplement le non des zones.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [Vent], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count
= 1 Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

"Daniel.C" a écrit dans le message de
news:

Bonjour Guy.
C'est un exemple de changement de couleur quand on change de valeur
en colonne B. La macro est listée sur la même feuille.
Cordialement.
Daniel

Re,
Bon.ça y est j'arrive à comprendre le modèle sans la 1ère feuille ?
A quoi sert la 1ère feuille "MFCCouleur" ?
Guy

"Modeste" a écrit dans le message de news:

Bonsour® Guy85 avec ferveur ;o))) vous nous disiez :

Je ne comprends pas.

"JB" a écrit dans le message de news:
http://boisgontierjacques.free.fr/fichiers/MFC/MFCZoneNum.xls

il te faut adapter la plage "CouleursNb" dans l'onglet Couleurs
selon tes definitions

il y a egalement cette possibilité :
http://www.xldynamic.com/source/xld.CFPlus.Download.html

sinon passer à Excel 7 !!!!

On 5 fév, 09:26, "Guy85" wrote:

Est-il possible d'avoir 6 MFC différentes ?
J'ai bien regardé plusieurs exemples, mais c'était toujours avec
une
valeur
déjà définie,
mais là je souhaiterais avec une condition.
1) <0 (Jeu de couleur, Police gras blanc).
2) de 0 à 12 (Jeu de couleur, Police gras Auto).
3) de 13 à 18 (Bleu glacier, Police gras Auto).
4) de 19 à 25 (Vert clair, Police gras Auto).
5) de 16 à 30 (Brun, Police gras Auto).
6) >30 (Rouge, Police gras jaune).

1ère

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row <> 9 Then Exit Sub
Application.EnableEvents = False
image = Application.Index([A90:A99], Application.Match(Target, [A90:A99], 0),
1)
If Target.Column = 61 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 61).Select
Cells(i, 61) = image 'Selection = Target.Value "Pour mettre le
texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 61).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
.Left = Cells(i, 61).Left
.Top = Cells(i, 61).Top
End With
ElseIf Target.Column = 63 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 63).Select
Cells(i, 63) = image 'Selection = Target.Value "Pour mettre le
texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 63).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
.Left = Cells(i, 63).Left
.Top = Cells(i, 63).Top
End With
End If
Application.EnableEvents = True
End Sub

2ème

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatV], 1)
If Not IsError(p) Then
Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Guy

"Daniel.C" a écrit dans le message de news:

Poste les deux macros.
Daniel

Bonsoir,
Je fais encore appel à toi, car avec le nouveau code que je mets dans un
autre classeur,
il fonctionne si je n'ai que ce code, il y da déjà un code dans cette
feuille et il a la même 1ère ligne de code.

Private Sub Worksheet_Change(ByVal Target As Range)

Même si j'enlève cette ligne et le "End sub" du 1er ça ne fonctionne plus.
Je pense qu'il doit y avoir un moyen de pouvoir faire fonctionner les deux
?
Mais le quel ?

Cordialement
Guy

"Daniel.C" a écrit dans le message de news:

Essaie :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatV], 1) 'FormatV au lieu de Vent
If Not IsError(p) Then
Range("FormatV")(p).Copy 'remplace :
'Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
'remplace :
'Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Daniel

Ok ci-joint :
http://www.cijoint.fr/cjlink.php?file=cj201002/cijFauydCv.xls
Guy

"Daniel.C" a écrit dans le message de news:

Peux-tu mettre ton classeur sur cjoint.com ?
Comme ça, cà a l'air bon...
Daniel

Bonjour Daniel.
J'arrive à utiliser cet exemple et à l'adaper.
Par contre, je souhaite avoir 2 zones différentes avec 2 format
différents
J'ai modifié le code, mais je pense qu'il y a autre chose à faire, ça
fonctionne pour l'un mais pas pour l'autre.
Voici le code modifié à ma manière.
C'est les deux même, mais en changeant simplement le non des zones.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [Vent], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count =
1 Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

"Daniel.C" a écrit dans le message de news:

Bonjour Guy.
C'est un exemple de changement de couleur quand on change de valeur
en colonne B. La macro est listée sur la même feuille.
Cordialement.
Daniel

Re,
Bon.ça y est j'arrive à comprendre le modèle sans la 1ère feuille ?
A quoi sert la 1ère feuille "MFCCouleur" ?
Guy

"Modeste" a écrit dans le message de news:

Bonsour® Guy85 avec ferveur ;o))) vous nous disiez :

Je ne comprends pas.

"JB" a écrit dans le message de news:
http://boisgontierjacques.free.fr/fichiers/MFC/MFCZoneNum.xls

il te faut adapter la plage "CouleursNb" dans l'onglet Couleurs
selon tes definitions

il y a egalement cette possibilité :
http://www.xldynamic.com/source/xld.CFPlus.Download.html

sinon passer à Excel 7 !!!!

On 5 fév, 09:26, "Guy85" wrote:

Est-il possible d'avoir 6 MFC différentes ?
J'ai bien regardé plusieurs exemples, mais c'était toujours avec
une
valeur
déjà définie,
mais là je souhaiterais avec une condition.
1) <0 (Jeu de couleur, Police gras blanc).
2) de 0 à 12 (Jeu de couleur, Police gras Auto).
3) de 13 à 18 (Bleu glacier, Police gras Auto).
4) de 19 à 25 (Vert clair, Police gras Auto).
5) de 16 à 30 (Brun, Police gras Auto).
6) >30 (Rouge, Police gras jaune).

Ca devrait fonctionner comme ça (on n'a droit qu'à une seule :
Sub Worksheet_Change
pour une feuille) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row = 9 Then
Application.EnableEvents = False
image = Application.Index([A90:A99], Application.Match(Target, [A90:A99],
0), 1)
If Target.Column = 61 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 61).Select
Cells(i, 61) = image 'Selection = Target.Value "Pour mettre le
texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 61).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
.Left = Cells(i, 61).Left
.Top = Cells(i, 61).Top
End With
ElseIf Target.Column = 63 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 63).Select
Cells(i, 63) = image 'Selection = Target.Value "Pour mettre
le texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 63).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
.Left = Cells(i, 63).Left
.Top = Cells(i, 63).Top
End With
End If
End If
Application.EnableEvents = True
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatV], 1)
If Not IsError(p) Then
Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Daniel

1ère

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row <> 9 Then Exit Sub
Application.EnableEvents = False
image = Application.Index([A90:A99], Application.Match(Target, [A90:A99],
0), 1)
If Target.Column = 61 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 61).Select
Cells(i, 61) = image 'Selection = Target.Value "Pour mettre
le texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 61).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
.Left = Cells(i, 61).Left
.Top = Cells(i, 61).Top
End With
ElseIf Target.Column = 63 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 63).Select
Cells(i, 63) = image 'Selection = Target.Value "Pour mettre
le texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 63).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
.Left = Cells(i, 63).Left
.Top = Cells(i, 63).Top
End With
End If
Application.EnableEvents = True
End Sub

2ème

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatV], 1)
If Not IsError(p) Then
Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Guy

"Daniel.C" a écrit dans le message de news:

Poste les deux macros.
Daniel

Bonsoir,
Je fais encore appel à toi, car avec le nouveau code que je mets dans
un autre classeur,
il fonctionne si je n'ai que ce code, il y da déjà un code dans cette
feuille et il a la même 1ère ligne de code.

Private Sub Worksheet_Change(ByVal Target As Range)

Même si j'enlève cette ligne et le "End sub" du 1er ça ne fonctionne
plus.
Je pense qu'il doit y avoir un moyen de pouvoir faire fonctionner les
deux ?
Mais le quel ?

Cordialement
Guy

"Daniel.C" a écrit dans le message de news:

Essaie :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatV], 1) 'FormatV au lieu de
Vent
If Not IsError(p) Then
Range("FormatV")(p).Copy 'remplace :
'Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count =
1 Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
'remplace :
'Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Daniel

Ok ci-joint :
http://www.cijoint.fr/cjlink.php?file=cj201002/cijFauydCv.xls
Guy

"Daniel.C" a écrit dans le message de
news:

Peux-tu mettre ton classeur sur cjoint.com ?
Comme ça, cà a l'air bon...
Daniel

Bonjour Daniel.
J'arrive à utiliser cet exemple et à l'adaper.
Par contre, je souhaite avoir 2 zones différentes avec 2 format
différents
J'ai modifié le code, mais je pense qu'il y a autre chose à faire,
ça fonctionne pour l'un mais pas pour l'autre.
Voici le code modifié à ma manière.
C'est les deux même, mais en changeant simplement le non des zones.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [Vent], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And
Target.Count = 1 Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

"Daniel.C" a écrit dans le message de
news:

Bonjour Guy.
C'est un exemple de changement de couleur quand on change de
valeur en colonne B. La macro est listée sur la même feuille.
Cordialement.
Daniel

Re,
Bon.ça y est j'arrive à comprendre le modèle sans la 1ère feuille
?
A quoi sert la 1ère feuille "MFCCouleur" ?
Guy

"Modeste" a écrit dans le message de news:

Bonsour® Guy85 avec ferveur ;o))) vous nous disiez :

Je ne comprends pas.

"JB" a écrit dans le message de news:
http://boisgontierjacques.free.fr/fichiers/MFC/MFCZoneNum.xls

il te faut adapter la plage "CouleursNb" dans l'onglet Couleurs
selon tes definitions

il y a egalement cette possibilité :
http://www.xldynamic.com/source/xld.CFPlus.Download.html

sinon passer à Excel 7 !!!!

On 5 fév, 09:26, "Guy85" wrote:

Est-il possible d'avoir 6 MFC différentes ?
J'ai bien regardé plusieurs exemples, mais c'était toujours
avec une
valeur
déjà définie,
mais là je souhaiterais avec une condition.
1) <0 (Jeu de couleur, Police gras blanc).
2) de 0 à 12 (Jeu de couleur, Police gras Auto).
3) de 13 à 18 (Bleu glacier, Police gras Auto).
4) de 19 à 25 (Vert clair, Police gras Auto).
5) de 16 à 30 (Brun, Police gras Auto).
6) >30 (Rouge, Police gras jaune).

Oui ça fonctionne encore une fois grace à toi (sans oublier les autres).
J'ai quand même un petit souci (qui existait avant dans la macro de JB)
Quand j'ai inscrit ma valeur le format change sans problème, mais j'ai 2
truc bizarre.
1) Après ma validation, la sélection ne vas pas vers le bas alors que
c'est coché.
2) Si j'appuie de nouveau sur "Entrée" cela me mets une autre valeur, car
il y a toujours une cellule de cellectionnée dans la plage de format.
j'ai mis en fin de code:

ActiveSheet.Paste
Application.CutCopyMode = False

Mais ça ne change rien.

"Daniel.C" a écrit dans le message de news:
OZ$P%

Ca devrait fonctionner comme ça (on n'a droit qu'à une seule :
Sub Worksheet_Change
pour une feuille) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row = 9 Then
Application.EnableEvents = False
image = Application.Index([A90:A99], Application.Match(Target, [A90:A99],
0), 1)
If Target.Column = 61 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 61).Select
Cells(i, 61) = image 'Selection = Target.Value "Pour mettre le
texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 61).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
.Left = Cells(i, 61).Left
.Top = Cells(i, 61).Top
End With
ElseIf Target.Column = 63 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 63).Select
Cells(i, 63) = image 'Selection = Target.Value "Pour mettre
le texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 63).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
.Left = Cells(i, 63).Left
.Top = Cells(i, 63).Top
End With
End If
End If
Application.EnableEvents = True
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatV], 1)
If Not IsError(p) Then
Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Daniel

1ère

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row <> 9 Then Exit Sub
Application.EnableEvents = False
image = Application.Index([A90:A99], Application.Match(Target,
[A90:A99], 0), 1)
If Target.Column = 61 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 61).Select
Cells(i, 61) = image 'Selection = Target.Value "Pour mettre
le texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 61).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
.Left = Cells(i, 61).Left
.Top = Cells(i, 61).Top
End With
ElseIf Target.Column = 63 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 63).Select
Cells(i, 63) = image 'Selection = Target.Value "Pour
mettre le texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 63).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
.Left = Cells(i, 63).Left
.Top = Cells(i, 63).Top
End With
End If
Application.EnableEvents = True
End Sub

2ème

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatV], 1)
If Not IsError(p) Then
Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Guy

"Daniel.C" a écrit dans le message de news:

Poste les deux macros.
Daniel

Bonsoir,
Je fais encore appel à toi, car avec le nouveau code que je mets dans
un autre classeur,
il fonctionne si je n'ai que ce code, il y da déjà un code dans cette
feuille et il a la même 1ère ligne de code.

Private Sub Worksheet_Change(ByVal Target As Range)

Même si j'enlève cette ligne et le "End sub" du 1er ça ne fonctionne
plus.
Je pense qu'il doit y avoir un moyen de pouvoir faire fonctionner les
deux ?
Mais le quel ?

Cordialement
Guy

"Daniel.C" a écrit dans le message de news:

Essaie :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [FormatV], 1) 'FormatV au lieu de
Vent
If Not IsError(p) Then
Range("FormatV")(p).Copy 'remplace :
'Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count
= 1 Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
'remplace :
'Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Daniel

Ok ci-joint :
http://www.cijoint.fr/cjlink.php?file=cj201002/cijFauydCv.xls
Guy

"Daniel.C" a écrit dans le message de
news:

Peux-tu mettre ton classeur sur cjoint.com ?
Comme ça, cà a l'air bon...
Daniel

Bonjour Daniel.
J'arrive à utiliser cet exemple et à l'adaper.
Par contre, je souhaite avoir 2 zones différentes avec 2 format
différents
J'ai modifié le code, mais je pense qu'il y a autre chose à faire,
ça fonctionne pour l'un mais pas pour l'autre.
Voici le code modifié à ma manière.
C'est les deux même, mais en changeant simplement le non des
zones.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [Vent], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And
Target.Count = 1 Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

"Daniel.C" a écrit dans le message de
news:

Bonjour Guy.
C'est un exemple de changement de couleur quand on change de
valeur en colonne B. La macro est listée sur la même feuille.
Cordialement.
Daniel

Re,
Bon.ça y est j'arrive à comprendre le modèle sans la 1ère
feuille ?
A quoi sert la 1ère feuille "MFCCouleur" ?
Guy

"Modeste" a écrit dans le message de news:

Bonsour® Guy85 avec ferveur ;o))) vous nous disiez :

Je ne comprends pas.

"JB" a écrit dans le message de news:
http://boisgontierjacques.free.fr/fichiers/MFC/MFCZoneNum.xls

il te faut adapter la plage "CouleursNb" dans l'onglet Couleurs
selon tes definitions

il y a egalement cette possibilité :
http://www.xldynamic.com/source/xld.CFPlus.Download.html

sinon passer à Excel 7 !!!!

On 5 fév, 09:26, "Guy85" wrote:

Est-il possible d'avoir 6 MFC différentes ?
J'ai bien regardé plusieurs exemples, mais c'était toujours
avec une
valeur
déjà définie,
mais là je souhaiterais avec une condition.
1) <0 (Jeu de couleur, Police gras blanc).
2) de 0 à 12 (Jeu de couleur, Police gras Auto).
3) de 13 à 18 (Bleu glacier, Police gras Auto).
4) de 19 à 25 (Vert clair, Police gras Auto).
5) de 16 à 30 (Brun, Police gras Auto).
6) >30 (Rouge, Police gras jaune).

En essayant mon fichier, je viens de m'apercevoir dans le début du code, avec
le collage d'image (qui fonctionne très bien) comme j'ai intercalé des
lignes.
Est-il possible que le texte et l'image se collent toutes les deux lignes ?

Guy

"Guy85" a écrit dans le message de news:
%

Oui ça fonctionne encore une fois grace à toi (sans oublier les autres).
J'ai quand même un petit souci (qui existait avant dans la macro de JB)
Quand j'ai inscrit ma valeur le format change sans problème, mais j'ai 2
truc bizarre.
1) Après ma validation, la sélection ne vas pas vers le bas alors que c'est
coché.
2) Si j'appuie de nouveau sur "Entrée" cela me mets une autre valeur, car
il y a toujours une cellule de cellectionnée dans la plage de format.
j'ai mis en fin de code:

ActiveSheet.Paste
Application.CutCopyMode = False

Mais ça ne change rien.

"Daniel.C" a écrit dans le message de news:
OZ$P%

Ca devrait fonctionner comme ça (on n'a droit qu'à une seule :
Sub Worksheet_Change
pour une feuille) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row = 9 Then
Application.EnableEvents = False
image = Application.Index([A90:A99], Application.Match(Target, [A90:A99],
0), 1)
If Target.Column = 61 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 61).Select
Cells(i, 61) = image 'Selection = Target.Value "Pour mettre le
texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 61).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
.Left = Cells(i, 61).Left
.Top = Cells(i, 61).Top
End With
ElseIf Target.Column = 63 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 63).Select
Cells(i, 63) = image 'Selection = Target.Value "Pour mettre
le texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 63).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
.Left = Cells(i, 63).Left
.Top = Cells(i, 63).Top
End With
End If
End If
Application.EnableEvents = True
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatV], 1)
If Not IsError(p) Then
Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Daniel

1ère

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row <> 9 Then Exit Sub
Application.EnableEvents = False
image = Application.Index([A90:A99], Application.Match(Target, [A90:A99],
0), 1)
If Target.Column = 61 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 61).Select
Cells(i, 61) = image 'Selection = Target.Value "Pour mettre
le texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 61).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
.Left = Cells(i, 61).Left
.Top = Cells(i, 61).Top
End With
ElseIf Target.Column = 63 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 63).Select
Cells(i, 63) = image 'Selection = Target.Value "Pour mettre
le texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 63).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
.Left = Cells(i, 63).Left
.Top = Cells(i, 63).Top
End With
End If
Application.EnableEvents = True
End Sub

2ème

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatV], 1)
If Not IsError(p) Then
Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Guy

"Daniel.C" a écrit dans le message de news:

Poste les deux macros.
Daniel

Bonsoir,
Je fais encore appel à toi, car avec le nouveau code que je mets dans
un autre classeur,
il fonctionne si je n'ai que ce code, il y da déjà un code dans cette
feuille et il a la même 1ère ligne de code.

Private Sub Worksheet_Change(ByVal Target As Range)

Même si j'enlève cette ligne et le "End sub" du 1er ça ne fonctionne
plus.
Je pense qu'il doit y avoir un moyen de pouvoir faire fonctionner les
deux ?
Mais le quel ?

Cordialement
Guy

"Daniel.C" a écrit dans le message de news:

Essaie :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatV], 1) 'FormatV au lieu de
Vent
If Not IsError(p) Then
Range("FormatV")(p).Copy 'remplace :
'Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count =
1 Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
'remplace :
'Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Daniel

Ok ci-joint :
http://www.cijoint.fr/cjlink.php?file=cj201002/cijFauydCv.xls
Guy

"Daniel.C" a écrit dans le message de
news:

Peux-tu mettre ton classeur sur cjoint.com ?
Comme ça, cà a l'air bon...
Daniel

Bonjour Daniel.
J'arrive à utiliser cet exemple et à l'adaper.
Par contre, je souhaite avoir 2 zones différentes avec 2 format
différents
J'ai modifié le code, mais je pense qu'il y a autre chose à faire,
ça fonctionne pour l'un mais pas pour l'autre.
Voici le code modifié à ma manière.
C'est les deux même, mais en changeant simplement le non des zones.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [Vent], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And
Target.Count = 1 Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

"Daniel.C" a écrit dans le message de
news:

Bonjour Guy.
C'est un exemple de changement de couleur quand on change de
valeur en colonne B. La macro est listée sur la même feuille.
Cordialement.
Daniel

Re,
Bon.ça y est j'arrive à comprendre le modèle sans la 1ère feuille
?
A quoi sert la 1ère feuille "MFCCouleur" ?
Guy

"Modeste" a écrit dans le message de news:

Bonsour® Guy85 avec ferveur ;o))) vous nous disiez :

Je ne comprends pas.

"JB" a écrit dans le message de news:
http://boisgontierjacques.free.fr/fichiers/MFC/MFCZoneNum.xls

il te faut adapter la plage "CouleursNb" dans l'onglet Couleurs
selon tes definitions

il y a egalement cette possibilité :
http://www.xldynamic.com/source/xld.CFPlus.Download.html

sinon passer à Excel 7 !!!!

On 5 fév, 09:26, "Guy85" wrote:

Est-il possible d'avoir 6 MFC différentes ?
J'ai bien regardé plusieurs exemples, mais c'était toujours
avec une
valeur
déjà définie,
mais là je souhaiterais avec une condition.
1) <0 (Jeu de couleur, Police gras blanc).
2) de 0 à 12 (Jeu de couleur, Police gras Auto).
3) de 13 à 18 (Bleu glacier, Police gras Auto).
4) de 19 à 25 (Vert clair, Police gras Auto).
5) de 16 à 30 (Brun, Police gras Auto).
6) >30 (Rouge, Police gras jaune).

Bonjour.
Est-ce que tu peux envoyer ton classeur via cjoint et détailler les manips
à faire pour reproduire le problème que tu évoques dans ton précédent
message ?
Daniel

En essayant mon fichier, je viens de m'apercevoir dans le début du code,
avec le collage d'image (qui fonctionne très bien) comme j'ai intercalé
des lignes.
Est-il possible que le texte et l'image se collent toutes les deux lignes
?

Guy

"Guy85" a écrit dans le message de news:
%

Oui ça fonctionne encore une fois grace à toi (sans oublier les
autres).
J'ai quand même un petit souci (qui existait avant dans la macro de JB)
Quand j'ai inscrit ma valeur le format change sans problème, mais j'ai 2
truc bizarre.
1) Après ma validation, la sélection ne vas pas vers le bas alors que
c'est coché.
2) Si j'appuie de nouveau sur "Entrée" cela me mets une autre valeur,
car il y a toujours une cellule de cellectionnée dans la plage de
format.
j'ai mis en fin de code:

ActiveSheet.Paste
Application.CutCopyMode = False

Mais ça ne change rien.

"Daniel.C" a écrit dans le message de news:
OZ$P%

Ca devrait fonctionner comme ça (on n'a droit qu'à une seule :
Sub Worksheet_Change
pour une feuille) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row = 9 Then
Application.EnableEvents = False
image = Application.Index([A90:A99], Application.Match(Target,
[A90:A99], 0), 1)
If Target.Column = 61 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 61).Select
Cells(i, 61) = image 'Selection = Target.Value "Pour mettre
le texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 61).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
.Left = Cells(i, 61).Left
.Top = Cells(i, 61).Top
End With
ElseIf Target.Column = 63 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 63).Select
Cells(i, 63) = image 'Selection = Target.Value "Pour
mettre le texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 63).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
.Left = Cells(i, 63).Left
.Top = Cells(i, 63).Top
End With
End If
End If
Application.EnableEvents = True
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1 Then
p = Application.Match(Target, [FormatV], 1)
If Not IsError(p) Then
Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count =
1 Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Daniel

1ère

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row <> 9 Then Exit Sub
Application.EnableEvents = False
image = Application.Index([A90:A99], Application.Match(Target,
[A90:A99], 0), 1)
If Target.Column = 61 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 61).Select
Cells(i, 61) = image 'Selection = Target.Value "Pour
mettre le texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 61).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 61).Address(0, 0))
.Left = Cells(i, 61).Left
.Top = Cells(i, 61).Top
End With
ElseIf Target.Column = 63 Then
For i = 13 To 81
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 63).Select
Cells(i, 63) = image 'Selection = Target.Value "Pour
mettre le texte"
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 63).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 63).Address(0, 0))
.Left = Cells(i, 63).Left
.Top = Cells(i, 63).Top
End With
End If
Application.EnableEvents = True
End Sub

2ème

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [FormatV], 1)
If Not IsError(p) Then
Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And Target.Count =
1 Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Guy

"Daniel.C" a écrit dans le message de news:

Poste les deux macros.
Daniel

Bonsoir,
Je fais encore appel à toi, car avec le nouveau code que je mets
dans un autre classeur,
il fonctionne si je n'ai que ce code, il y da déjà un code dans
cette feuille et il a la même 1ère ligne de code.

Private Sub Worksheet_Change(ByVal Target As Range)

Même si j'enlève cette ligne et le "End sub" du 1er ça ne fonctionne
plus.
Je pense qu'il doit y avoir un moyen de pouvoir faire fonctionner
les deux ?
Mais le quel ?

Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:

Essaie :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count = 1
Then
p = Application.Match(Target, [FormatV], 1) 'FormatV au lieu de
Vent
If Not IsError(p) Then
Range("FormatV")(p).Copy 'remplace :
'Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And
Target.Count = 1 Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Range("FormatT")(p).Copy
'remplace :
'Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

Daniel

Ok ci-joint :
http://www.cijoint.fr/cjlink.php?file=cj201002/cijFauydCv.xls
Guy

"Daniel.C" a écrit dans le message de
news:

Peux-tu mettre ton classeur sur cjoint.com ?
Comme ça, cà a l'air bon...
Daniel

Bonjour Daniel.
J'arrive à utiliser cet exemple et à l'adaper.
Par contre, je souhaite avoir 2 zones différentes avec 2 format
différents
J'ai modifié le code, mais je pense qu'il y a autre chose à
faire, ça fonctionne pour l'un mais pas pour l'autre.
Voici le code modifié à ma manière.
C'est les deux même, mais en changeant simplement le non des
zones.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([Vent], Target) Is Nothing And Target.Count =
1 Then
p = Application.Match(Target, [Vent], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatV")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If

If Not Intersect([Températures], Target) Is Nothing And
Target.Count = 1 Then
p = Application.Match(Target, [FormatT], 1)
If Not IsError(p) Then
Sheets("couleurs").Range("FormatT")(p).Copy
Application.EnableEvents = False
Target.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
End If
End If
End Sub

"Daniel.C" a écrit dans le message de
news:

Bonjour Guy.
C'est un exemple de changement de couleur quand on change de
valeur en colonne B. La macro est listée sur la même feuille.
Cordialement.
Daniel

Re,
Bon.ça y est j'arrive à comprendre le modèle sans la 1ère
feuille ?
A quoi sert la 1ère feuille "MFCCouleur" ?
Guy

"Modeste" a écrit dans le message de news:

Bonsour® Guy85 avec ferveur ;o))) vous nous disiez :

Je ne comprends pas.

"JB" a écrit dans le message de
news:
http://boisgontierjacques.free.fr/fichiers/MFC/MFCZoneNum.xls

il te faut adapter la plage "CouleursNb" dans l'onglet
Couleurs selon tes definitions

il y a egalement cette possibilité :
http://www.xldynamic.com/source/xld.CFPlus.Download.html

sinon passer à Excel 7 !!!!

On 5 fév, 09:26, "Guy85" wrote:

Est-il possible d'avoir 6 MFC différentes ?
J'ai bien regardé plusieurs exemples, mais c'était toujours
avec une
valeur
déjà définie,
mais là je souhaiterais avec une condition.
1) <0 (Jeu de couleur, Police gras blanc).
2) de 0 à 12 (Jeu de couleur, Police gras Auto).
3) de 13 à 18 (Bleu glacier, Police gras Auto).
4) de 19 à 25 (Vert clair, Police gras Auto).
5) de 16 à 30 (Brun, Police gras Auto).
6) >30 (Rouge, Police gras jaune).