Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Texte appel image

Texte appel image

30 réponses
Avatar
Guy72
Bonjour,
Est-il possible d'après un texte par exemple: "Pluie" en cellule D6 et de
faire apparaître une image en cellule F6 ?
L'image se trouve dans le même dossier.
http://www.cijoint.fr/cjlink.php?file=cj200911/cijFdbPym5.xls
--
Cordialement
Guy
Signaler un problème avec ce contenu

10 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
1 2 3
Avatar
Guy72
Pas possible, si je la supprime, ça ne fonctionne plus.
Il me semble qu'elle est aussi dans ton code "image =
Application.Index([A6:A30], Application.Match(Target, [A6:A30], 0), 1)"
--
Cordialement
Guy

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

Juste un oubli...
Daniel

Ok c'est parfait.
Mais encore une petite question.
A quoi sert la liste en colonne A ?
--
Cordialement
Guy

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

Essaie ce code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row <> 1 Then Exit Sub
Application.EnableEvents = False
image = Application.Index([A6:A30], Application.Match(Target, [A6:A30],
0), 1)
If Target.Column = 5 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 5).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 5).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
.Left = Cells(i, 5).Left
.Top = Cells(i, 5).Top
End With
ElseIf Target.Column = 6 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 6).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 6).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
.Left = Cells(i, 6).Left
.Top = Cells(i, 6).Top
End With
End If
Application.EnableEvents = True
End Sub

Daniel

C'est tout à fait ça.
Pour l'instant le seul problème que je trouve ç' est l'emplacement des
image,elle ne se mette pas en haut à gauche de la cellule.
Comment peut-on avoir les image toujours dans le même alignement.
--
Cordialement
Guy

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

Teste le classeur suivant :
http://cjoint.com/?lztWd1zHsz
(je m'absente pour une dizaine de jours; relance le forum en cas de
besoin).
Daniel

En colonne B les cellules de validation du matin.
En colonne C les cellules de validation de l'après -midi.
En colonne E les images du matin.
En colonne F les images de l'après-midi.
La liste, n'importe ou en dessous de la ligne 40 ou en colonne N.
Si ?c'est possible? de faire qu'une cellule de validation pour
chaque partie les mettre en E1 pour le matin (c'est à dire qu'à
chaque validation l'image irai en cellule E6 puis en E7 puis en E8
jusqu'à 31 jours (E37), et en F1 pour l'après-midi (c'est à dire qu'à
chaque validation l'image irai en cellule F6 puis en F7 puis en
F8jusqu'à 31 jours (F37).



--
Cordialement
Guy
"Daniel.C" a écrit dans le message de
news:
Dis voir les colonnes que tu veux utiliser pour les listes de
validation et pour les images.
Daniel

Oui sait ce que je voulais!!!
Cela me fais penser à autre chose.
Si je fais ça pour une journée, est-il possible sur la même feuille
de faire ç par 1/2 journée ?
Matin image en colonne F.
Après-midi en colonne G.
Je suppose avec une 2ème liste déroulante ?
Mais au niveau du code..........?
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
http://cjoint.com/?lzoZh1jB23
Daniel

Non, ça peut être 6,7,8,9,10,11 jusqu'à 31 jours
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
T'es bien sûr que c'est 6, 9, 11, 13 ? t'arranges pas mes
affaires !
Daniel

Ok ça fonctionne seulement pour avoir.
D6(Texte liste déroulante)et F6(résultat image suivant le choix
de D6).Ok

Mais si je souhaiterais avoir la même chose dans les cellules
en dessous.
D9(Texte liste déroulante) et F9(résultat image suivant le
choix de D9).
D11(Texte liste déroulante) et F11(résultat image suivant le
choix de D11).
etc.........
Pour ça les images doivent rester en place.
--
Cordialement
Guy

"Daniel.C" a écrit dans le message
de news:
Ou plutôt cette syntaxe :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
On Error Resume Next
ActiveSheet.Shapes("toto").Delete
On Error GoTo 0
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Selection.ShapeRange.Name = "toto"
End If
End Sub

Daniel


Au temps ppour moi.
Remplace la macro par :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
ActiveSheet.Shapes(Shapes.Count).Delete
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
End If
End Sub

(le nom des images est en A6 et plus bas). J'ai ajouté le
delete de l'image précédente, en fait, la dernière collée sur
la feuille. Fais donc attention si tu en ajoutes.
Daniel

Bonjour,
D'accord ça fonctionne avec des noms différent dans le code.
La liste déroulante me conviens bien.
Il faut donc que je copie autant de fois le code que noms
différents "ActiveSheet.Shapes.Range("Pluie").Select" et de
cellules différentes "If Target.Address = "$D$6" Then" et
"Range("F6").Select"?
Exemple : Texte D6 Image F6, Texte D7 Image F7, Texte D8
Image F8, etc......
Merci de votre aide












































Avatar
Guy72
Bonjour,
Suis-je bête, il suffit de changer dans le code.
--
Cordialement
Guy

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

Juste un oubli...
Daniel

Ok c'est parfait.
Mais encore une petite question.
A quoi sert la liste en colonne A ?
--
Cordialement
Guy

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

Essaie ce code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row <> 1 Then Exit Sub
Application.EnableEvents = False
image = Application.Index([A6:A30], Application.Match(Target, [A6:A30],
0), 1)
If Target.Column = 5 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 5).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 5).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
.Left = Cells(i, 5).Left
.Top = Cells(i, 5).Top
End With
ElseIf Target.Column = 6 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 6).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 6).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
.Left = Cells(i, 6).Left
.Top = Cells(i, 6).Top
End With
End If
Application.EnableEvents = True
End Sub

Daniel

C'est tout à fait ça.
Pour l'instant le seul problème que je trouve ç' est l'emplacement des
image,elle ne se mette pas en haut à gauche de la cellule.
Comment peut-on avoir les image toujours dans le même alignement.
--
Cordialement
Guy

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

Teste le classeur suivant :
http://cjoint.com/?lztWd1zHsz
(je m'absente pour une dizaine de jours; relance le forum en cas de
besoin).
Daniel

En colonne B les cellules de validation du matin.
En colonne C les cellules de validation de l'après -midi.
En colonne E les images du matin.
En colonne F les images de l'après-midi.
La liste, n'importe ou en dessous de la ligne 40 ou en colonne N.
Si ?c'est possible? de faire qu'une cellule de validation pour
chaque partie les mettre en E1 pour le matin (c'est à dire qu'à
chaque validation l'image irai en cellule E6 puis en E7 puis en E8
jusqu'à 31 jours (E37), et en F1 pour l'après-midi (c'est à dire qu'à
chaque validation l'image irai en cellule F6 puis en F7 puis en
F8jusqu'à 31 jours (F37).



--
Cordialement
Guy
"Daniel.C" a écrit dans le message de
news:
Dis voir les colonnes que tu veux utiliser pour les listes de
validation et pour les images.
Daniel

Oui sait ce que je voulais!!!
Cela me fais penser à autre chose.
Si je fais ça pour une journée, est-il possible sur la même feuille
de faire ç par 1/2 journée ?
Matin image en colonne F.
Après-midi en colonne G.
Je suppose avec une 2ème liste déroulante ?
Mais au niveau du code..........?
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
http://cjoint.com/?lzoZh1jB23
Daniel

Non, ça peut être 6,7,8,9,10,11 jusqu'à 31 jours
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
T'es bien sûr que c'est 6, 9, 11, 13 ? t'arranges pas mes
affaires !
Daniel

Ok ça fonctionne seulement pour avoir.
D6(Texte liste déroulante)et F6(résultat image suivant le choix
de D6).Ok

Mais si je souhaiterais avoir la même chose dans les cellules
en dessous.
D9(Texte liste déroulante) et F9(résultat image suivant le
choix de D9).
D11(Texte liste déroulante) et F11(résultat image suivant le
choix de D11).
etc.........
Pour ça les images doivent rester en place.
--
Cordialement
Guy

"Daniel.C" a écrit dans le message
de news:
Ou plutôt cette syntaxe :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
On Error Resume Next
ActiveSheet.Shapes("toto").Delete
On Error GoTo 0
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Selection.ShapeRange.Name = "toto"
End If
End Sub

Daniel


Au temps ppour moi.
Remplace la macro par :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
ActiveSheet.Shapes(Shapes.Count).Delete
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
End If
End Sub

(le nom des images est en A6 et plus bas). J'ai ajouté le
delete de l'image précédente, en fait, la dernière collée sur
la feuille. Fais donc attention si tu en ajoutes.
Daniel

Bonjour,
D'accord ça fonctionne avec des noms différent dans le code.
La liste déroulante me conviens bien.
Il faut donc que je copie autant de fois le code que noms
différents "ActiveSheet.Shapes.Range("Pluie").Select" et de
cellules différentes "If Target.Address = "$D$6" Then" et
"Range("F6").Select"?
Exemple : Texte D6 Image F6, Texte D7 Image F7, Texte D8
Image F8, etc......
Merci de votre aide












































Avatar
PLG
Bonsoir Guy

Je passais par là...
Ce n'est pas Photo4 mais : AffichePhoto4
C'est le nom de l'onglet

Bonsoir

"Guy72" wrote:

Bonjour JB
Pourquoi "Photo4" ?
"nomimage"n'a rien à voir ?
--
Cordialement
Guy

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



http://boisgontierjacques.free.fr/pages_site/donneesvalidation.htm#choixImage

JB

On 25 nov, 10:52, "Guy72" wrote:
> Bonjour JB
> Ce ne sont pas des images .jpg.
> En fait elles seront sur la même feuille
> --
> Cordialement
> Guy
>
> "JB" a écrit dans le message de news:
>
> Bonjour,
>
> http://boisgontierjacques.free.fr/pages_site/lesimages.htm#FonctionAf...
>
> JBhttp://boisgontierjacques.free.fr
>
> On 25 nov, 09:27, "Guy72" wrote:
>
>
>
> > Bonjour,
> > Est-il possible d'après un texte par exemple: "Pluie" en cellule D6 et
> > de
> > faire apparaître une image en cellule F6 ?
> > L'image se trouve dans le même
> > dossier.http://www.cijoint.fr/cjlink.php?file=cj200911/cijFdbPym5.xls
> > --
> > Cordialement
> > Guy- Masquer le texte des messages précédents -
>
> - Afficher le texte des messages précédents -


.



Avatar
Daniel.C
Exact :
remplace par :
image = Application.Index([N1:N30], Application.Match(Target, [N1:N30],
0), 1)
ou plus que 30 si tu as plus d'images. Le top serait une plage
dynamique (utilisant ÞCALER) ou un tableau XL2007. Indique-moi ta
version. Si j'ai le temps, je te poste ça aujourd'hui.
Daniel

Pas possible, si je la supprime, ça ne fonctionne plus.
Il me semble qu'elle est aussi dans ton code "image =
Application.Index([A6:A30], Application.Match(Target, [A6:A30], 0), 1)"
--
Cordialement
Guy

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

Juste un oubli...
Daniel

Ok c'est parfait.
Mais encore une petite question.
A quoi sert la liste en colonne A ?
--
Cordialement
Guy

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

Essaie ce code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row <> 1 Then Exit Sub
Application.EnableEvents = False
image = Application.Index([A6:A30], Application.Match(Target, [A6:A30],
0), 1)
If Target.Column = 5 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 5).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 5).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
.Left = Cells(i, 5).Left
.Top = Cells(i, 5).Top
End With
ElseIf Target.Column = 6 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 6).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 6).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
.Left = Cells(i, 6).Left
.Top = Cells(i, 6).Top
End With
End If
Application.EnableEvents = True
End Sub

Daniel

C'est tout à fait ça.
Pour l'instant le seul problème que je trouve ç' est l'emplacement des
image,elle ne se mette pas en haut à gauche de la cellule.
Comment peut-on avoir les image toujours dans le même alignement.
--
Cordialement
Guy

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

Teste le classeur suivant :
http://cjoint.com/?lztWd1zHsz
(je m'absente pour une dizaine de jours; relance le forum en cas de
besoin).
Daniel

En colonne B les cellules de validation du matin.
En colonne C les cellules de validation de l'après -midi.
En colonne E les images du matin.
En colonne F les images de l'après-midi.
La liste, n'importe ou en dessous de la ligne 40 ou en colonne N.
Si ?c'est possible? de faire qu'une cellule de validation pour
chaque partie les mettre en E1 pour le matin (c'est à dire qu'à chaque
validation l'image irai en cellule E6 puis en E7 puis en E8 jusqu'à 31
jours (E37), et en F1 pour l'après-midi (c'est à dire qu'à chaque
validation l'image irai en cellule F6 puis en F7 puis en F8jusqu'à 31
jours (F37).



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

Dis voir les colonnes que tu veux utiliser pour les listes de
validation et pour les images.
Daniel

Oui sait ce que je voulais!!!
Cela me fais penser à autre chose.
Si je fais ça pour une journée, est-il possible sur la même feuille
de faire ç par 1/2 journée ?
Matin image en colonne F.
Après-midi en colonne G.
Je suppose avec une 2ème liste déroulante ?
Mais au niveau du code..........?
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
http://cjoint.com/?lzoZh1jB23
Daniel

Non, ça peut être 6,7,8,9,10,11 jusqu'à 31 jours
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
T'es bien sûr que c'est 6, 9, 11, 13 ? t'arranges pas mes
affaires !
Daniel

Ok ça fonctionne seulement pour avoir.
D6(Texte liste déroulante)et F6(résultat image suivant le choix
de D6).Ok

Mais si je souhaiterais avoir la même chose dans les cellules en
dessous.
D9(Texte liste déroulante) et F9(résultat image suivant le choix
de D9).
D11(Texte liste déroulante) et F11(résultat image suivant le
choix de D11).
etc.........
Pour ça les images doivent rester en place.
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
Ou plutôt cette syntaxe :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
On Error Resume Next
ActiveSheet.Shapes("toto").Delete
On Error GoTo 0
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Selection.ShapeRange.Name = "toto"
End If
End Sub

Daniel


Au temps ppour moi.
Remplace la macro par :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
ActiveSheet.Shapes(Shapes.Count).Delete
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
End If
End Sub

(le nom des images est en A6 et plus bas). J'ai ajouté le
delete de l'image précédente, en fait, la dernière collée sur
la feuille. Fais donc attention si tu en ajoutes.
Daniel

Bonjour,
D'accord ça fonctionne avec des noms différent dans le code.
La liste déroulante me conviens bien.
Il faut donc que je copie autant de fois le code que noms
différents "ActiveSheet.Shapes.Range("Pluie").Select" et de
cellules différentes "If Target.Address = "$D$6" Then" et
"Range("F6").Select"?
Exemple : Texte D6 Image F6, Texte D7 Image F7, Texte D8
Image F8, etc......
Merci de votre aide














































Avatar
Guy72
Bonjour Daniel,
J'avais trouvé pourquoi "message du 26/11-08:32.
Le nombre d'images ne dépasse pas 10.
Ma version est EXCEL 2003
--
Cordialement
Guy

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

Exact :
remplace par :
image = Application.Index([N1:N30], Application.Match(Target, [N1:N30],
0), 1)
ou plus que 30 si tu as plus d'images. Le top serait une plage dynamique
(utilisant ÞCALER) ou un tableau XL2007. Indique-moi ta version. Si j'ai
le temps, je te poste ça aujourd'hui.
Daniel

Pas possible, si je la supprime, ça ne fonctionne plus.
Il me semble qu'elle est aussi dans ton code "image =
Application.Index([A6:A30], Application.Match(Target, [A6:A30], 0), 1)"
--
Cordialement
Guy

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

Juste un oubli...
Daniel

Ok c'est parfait.
Mais encore une petite question.
A quoi sert la liste en colonne A ?
--
Cordialement
Guy

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

Essaie ce code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row <> 1 Then Exit Sub
Application.EnableEvents = False
image = Application.Index([A6:A30], Application.Match(Target,
[A6:A30], 0), 1)
If Target.Column = 5 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 5).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 5).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
.Left = Cells(i, 5).Left
.Top = Cells(i, 5).Top
End With
ElseIf Target.Column = 6 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 6).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 6).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
.Left = Cells(i, 6).Left
.Top = Cells(i, 6).Top
End With
End If
Application.EnableEvents = True
End Sub

Daniel

C'est tout à fait ça.
Pour l'instant le seul problème que je trouve ç' est l'emplacement
des image,elle ne se mette pas en haut à gauche de la cellule.
Comment peut-on avoir les image toujours dans le même alignement.
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
Teste le classeur suivant :
http://cjoint.com/?lztWd1zHsz
(je m'absente pour une dizaine de jours; relance le forum en cas de
besoin).
Daniel

En colonne B les cellules de validation du matin.
En colonne C les cellules de validation de l'après -midi.
En colonne E les images du matin.
En colonne F les images de l'après-midi.
La liste, n'importe ou en dessous de la ligne 40 ou en colonne N.
Si ?c'est possible? de faire qu'une cellule de validation pour
chaque partie les mettre en E1 pour le matin (c'est à dire qu'à
chaque validation l'image irai en cellule E6 puis en E7 puis en E8
jusqu'à 31 jours (E37), et en F1 pour l'après-midi (c'est à dire
qu'à chaque validation l'image irai en cellule F6 puis en F7 puis
en F8jusqu'à 31 jours (F37).



--
Cordialement
Guy
"Daniel.C" a écrit dans le message de
news:
Dis voir les colonnes que tu veux utiliser pour les listes de
validation et pour les images.
Daniel

Oui sait ce que je voulais!!!
Cela me fais penser à autre chose.
Si je fais ça pour une journée, est-il possible sur la même
feuille de faire ç par 1/2 journée ?
Matin image en colonne F.
Après-midi en colonne G.
Je suppose avec une 2ème liste déroulante ?
Mais au niveau du code..........?
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
http://cjoint.com/?lzoZh1jB23
Daniel

Non, ça peut être 6,7,8,9,10,11 jusqu'à 31 jours
--
Cordialement
Guy

"Daniel.C" a écrit dans le message
de news:
T'es bien sûr que c'est 6, 9, 11, 13 ? t'arranges pas mes
affaires !
Daniel

Ok ça fonctionne seulement pour avoir.
D6(Texte liste déroulante)et F6(résultat image suivant le
choix de D6).Ok

Mais si je souhaiterais avoir la même chose dans les cellules
en dessous.
D9(Texte liste déroulante) et F9(résultat image suivant le
choix de D9).
D11(Texte liste déroulante) et F11(résultat image suivant le
choix de D11).
etc.........
Pour ça les images doivent rester en place.
--
Cordialement
Guy

"Daniel.C" a écrit dans le message
de news:
Ou plutôt cette syntaxe :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
On Error Resume Next
ActiveSheet.Shapes("toto").Delete
On Error GoTo 0
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Selection.ShapeRange.Name = "toto"
End If
End Sub

Daniel


Au temps ppour moi.
Remplace la macro par :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
ActiveSheet.Shapes(Shapes.Count).Delete
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
End If
End Sub

(le nom des images est en A6 et plus bas). J'ai ajouté le
delete de l'image précédente, en fait, la dernière collée
sur la feuille. Fais donc attention si tu en ajoutes.
Daniel

Bonjour,
D'accord ça fonctionne avec des noms différent dans le
code.
La liste déroulante me conviens bien.
Il faut donc que je copie autant de fois le code que noms
différents "ActiveSheet.Shapes.Range("Pluie").Select" et
de cellules différentes "If Target.Address = "$D$6" Then"
et "Range("F6").Select"?
Exemple : Texte D6 Image F6, Texte D7 Image F7, Texte D8
Image F8, etc......
Merci de votre aide


















































Avatar
Daniel.C
Voila, avecune plage dynamique :
http://www.cijoint.fr/cjlink.php?file=cj200912/cijnlvd3gw.xls
Daniel

Pas possible, si je la supprime, ça ne fonctionne plus.
Il me semble qu'elle est aussi dans ton code "image =
Application.Index([A6:A30], Application.Match(Target, [A6:A30], 0), 1)"
--
Cordialement
Guy

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

Juste un oubli...
Daniel

Ok c'est parfait.
Mais encore une petite question.
A quoi sert la liste en colonne A ?
--
Cordialement
Guy

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

Essaie ce code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row <> 1 Then Exit Sub
Application.EnableEvents = False
image = Application.Index([A6:A30], Application.Match(Target, [A6:A30],
0), 1)
If Target.Column = 5 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 5).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 5).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
.Left = Cells(i, 5).Left
.Top = Cells(i, 5).Top
End With
ElseIf Target.Column = 6 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 6).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 6).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
.Left = Cells(i, 6).Left
.Top = Cells(i, 6).Top
End With
End If
Application.EnableEvents = True
End Sub

Daniel

C'est tout à fait ça.
Pour l'instant le seul problème que je trouve ç' est l'emplacement des
image,elle ne se mette pas en haut à gauche de la cellule.
Comment peut-on avoir les image toujours dans le même alignement.
--
Cordialement
Guy

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

Teste le classeur suivant :
http://cjoint.com/?lztWd1zHsz
(je m'absente pour une dizaine de jours; relance le forum en cas de
besoin).
Daniel

En colonne B les cellules de validation du matin.
En colonne C les cellules de validation de l'après -midi.
En colonne E les images du matin.
En colonne F les images de l'après-midi.
La liste, n'importe ou en dessous de la ligne 40 ou en colonne N.
Si ?c'est possible? de faire qu'une cellule de validation pour
chaque partie les mettre en E1 pour le matin (c'est à dire qu'à chaque
validation l'image irai en cellule E6 puis en E7 puis en E8 jusqu'à 31
jours (E37), et en F1 pour l'après-midi (c'est à dire qu'à chaque
validation l'image irai en cellule F6 puis en F7 puis en F8jusqu'à 31
jours (F37).



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

Dis voir les colonnes que tu veux utiliser pour les listes de
validation et pour les images.
Daniel

Oui sait ce que je voulais!!!
Cela me fais penser à autre chose.
Si je fais ça pour une journée, est-il possible sur la même feuille
de faire ç par 1/2 journée ?
Matin image en colonne F.
Après-midi en colonne G.
Je suppose avec une 2ème liste déroulante ?
Mais au niveau du code..........?
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
http://cjoint.com/?lzoZh1jB23
Daniel

Non, ça peut être 6,7,8,9,10,11 jusqu'à 31 jours
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
T'es bien sûr que c'est 6, 9, 11, 13 ? t'arranges pas mes
affaires !
Daniel

Ok ça fonctionne seulement pour avoir.
D6(Texte liste déroulante)et F6(résultat image suivant le choix
de D6).Ok

Mais si je souhaiterais avoir la même chose dans les cellules en
dessous.
D9(Texte liste déroulante) et F9(résultat image suivant le choix
de D9).
D11(Texte liste déroulante) et F11(résultat image suivant le
choix de D11).
etc.........
Pour ça les images doivent rester en place.
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
Ou plutôt cette syntaxe :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
On Error Resume Next
ActiveSheet.Shapes("toto").Delete
On Error GoTo 0
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Selection.ShapeRange.Name = "toto"
End If
End Sub

Daniel


Au temps ppour moi.
Remplace la macro par :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
ActiveSheet.Shapes(Shapes.Count).Delete
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
End If
End Sub

(le nom des images est en A6 et plus bas). J'ai ajouté le
delete de l'image précédente, en fait, la dernière collée sur
la feuille. Fais donc attention si tu en ajoutes.
Daniel

Bonjour,
D'accord ça fonctionne avec des noms différent dans le code.
La liste déroulante me conviens bien.
Il faut donc que je copie autant de fois le code que noms
différents "ActiveSheet.Shapes.Range("Pluie").Select" et de
cellules différentes "If Target.Address = "$D$6" Then" et
"Range("F6").Select"?
Exemple : Texte D6 Image F6, Texte D7 Image F7, Texte D8
Image F8, etc......
Merci de votre aide














































Avatar
Guy72
D'accord.
Je suppose...... que le nom "début" peut être supprimé ?
Je suppose aussi........que le module "test" peut être supprimé également ?
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de news:
%
Voila, avecune plage dynamique :
http://www.cijoint.fr/cjlink.php?file=cj200912/cijnlvd3gw.xls
Daniel

Pas possible, si je la supprime, ça ne fonctionne plus.
Il me semble qu'elle est aussi dans ton code "image =
Application.Index([A6:A30], Application.Match(Target, [A6:A30], 0), 1)"
--
Cordialement
Guy

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

Juste un oubli...
Daniel

Ok c'est parfait.
Mais encore une petite question.
A quoi sert la liste en colonne A ?
--
Cordialement
Guy

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

Essaie ce code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row <> 1 Then Exit Sub
Application.EnableEvents = False
image = Application.Index([A6:A30], Application.Match(Target,
[A6:A30], 0), 1)
If Target.Column = 5 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 5).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 5).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
.Left = Cells(i, 5).Left
.Top = Cells(i, 5).Top
End With
ElseIf Target.Column = 6 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 6).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 6).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
.Left = Cells(i, 6).Left
.Top = Cells(i, 6).Top
End With
End If
Application.EnableEvents = True
End Sub

Daniel

C'est tout à fait ça.
Pour l'instant le seul problème que je trouve ç' est l'emplacement
des image,elle ne se mette pas en haut à gauche de la cellule.
Comment peut-on avoir les image toujours dans le même alignement.
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
Teste le classeur suivant :
http://cjoint.com/?lztWd1zHsz
(je m'absente pour une dizaine de jours; relance le forum en cas de
besoin).
Daniel

En colonne B les cellules de validation du matin.
En colonne C les cellules de validation de l'après -midi.
En colonne E les images du matin.
En colonne F les images de l'après-midi.
La liste, n'importe ou en dessous de la ligne 40 ou en colonne N.
Si ?c'est possible? de faire qu'une cellule de validation pour
chaque partie les mettre en E1 pour le matin (c'est à dire qu'à
chaque validation l'image irai en cellule E6 puis en E7 puis en E8
jusqu'à 31 jours (E37), et en F1 pour l'après-midi (c'est à dire
qu'à chaque validation l'image irai en cellule F6 puis en F7 puis
en F8jusqu'à 31 jours (F37).



--
Cordialement
Guy
"Daniel.C" a écrit dans le message de
news:
Dis voir les colonnes que tu veux utiliser pour les listes de
validation et pour les images.
Daniel

Oui sait ce que je voulais!!!
Cela me fais penser à autre chose.
Si je fais ça pour une journée, est-il possible sur la même
feuille de faire ç par 1/2 journée ?
Matin image en colonne F.
Après-midi en colonne G.
Je suppose avec une 2ème liste déroulante ?
Mais au niveau du code..........?
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
http://cjoint.com/?lzoZh1jB23
Daniel

Non, ça peut être 6,7,8,9,10,11 jusqu'à 31 jours
--
Cordialement
Guy

"Daniel.C" a écrit dans le message
de news:
T'es bien sûr que c'est 6, 9, 11, 13 ? t'arranges pas mes
affaires !
Daniel

Ok ça fonctionne seulement pour avoir.
D6(Texte liste déroulante)et F6(résultat image suivant le
choix de D6).Ok

Mais si je souhaiterais avoir la même chose dans les cellules
en dessous.
D9(Texte liste déroulante) et F9(résultat image suivant le
choix de D9).
D11(Texte liste déroulante) et F11(résultat image suivant le
choix de D11).
etc.........
Pour ça les images doivent rester en place.
--
Cordialement
Guy

"Daniel.C" a écrit dans le message
de news:
Ou plutôt cette syntaxe :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
On Error Resume Next
ActiveSheet.Shapes("toto").Delete
On Error GoTo 0
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Selection.ShapeRange.Name = "toto"
End If
End Sub

Daniel


Au temps ppour moi.
Remplace la macro par :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
ActiveSheet.Shapes(Shapes.Count).Delete
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
End If
End Sub

(le nom des images est en A6 et plus bas). J'ai ajouté le
delete de l'image précédente, en fait, la dernière collée
sur la feuille. Fais donc attention si tu en ajoutes.
Daniel

Bonjour,
D'accord ça fonctionne avec des noms différent dans le
code.
La liste déroulante me conviens bien.
Il faut donc que je copie autant de fois le code que noms
différents "ActiveSheet.Shapes.Range("Pluie").Select" et
de cellules différentes "If Target.Address = "$D$6" Then"
et "Range("F6").Select"?
Exemple : Texte D6 Image F6, Texte D7 Image F7, Texte D8
Image F8, etc......
Merci de votre aide


















































Avatar
Daniel.C
Absolument.
Daniel

D'accord.
Je suppose...... que le nom "début" peut être supprimé ?
Je suppose aussi........que le module "test" peut être supprimé également ?
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de news:
%
Voila, avecune plage dynamique :
http://www.cijoint.fr/cjlink.php?file=cj200912/cijnlvd3gw.xls
Daniel

Pas possible, si je la supprime, ça ne fonctionne plus.
Il me semble qu'elle est aussi dans ton code "image =
Application.Index([A6:A30], Application.Match(Target, [A6:A30], 0), 1)"
--
Cordialement
Guy

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

Juste un oubli...
Daniel

Ok c'est parfait.
Mais encore une petite question.
A quoi sert la liste en colonne A ?
--
Cordialement
Guy

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

Essaie ce code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row <> 1 Then Exit Sub
Application.EnableEvents = False
image = Application.Index([A6:A30], Application.Match(Target, [A6:A30],
0), 1)
If Target.Column = 5 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 5).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 5).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
.Left = Cells(i, 5).Left
.Top = Cells(i, 5).Top
End With
ElseIf Target.Column = 6 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 6).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 6).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
.Left = Cells(i, 6).Left
.Top = Cells(i, 6).Top
End With
End If
Application.EnableEvents = True
End Sub

Daniel

C'est tout à fait ça.
Pour l'instant le seul problème que je trouve ç' est l'emplacement des
image,elle ne se mette pas en haut à gauche de la cellule.
Comment peut-on avoir les image toujours dans le même alignement.
--
Cordialement
Guy

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

Teste le classeur suivant :
http://cjoint.com/?lztWd1zHsz
(je m'absente pour une dizaine de jours; relance le forum en cas de
besoin).
Daniel

En colonne B les cellules de validation du matin.
En colonne C les cellules de validation de l'après -midi.
En colonne E les images du matin.
En colonne F les images de l'après-midi.
La liste, n'importe ou en dessous de la ligne 40 ou en colonne N.
Si ?c'est possible? de faire qu'une cellule de validation pour
chaque partie les mettre en E1 pour le matin (c'est à dire qu'à
chaque validation l'image irai en cellule E6 puis en E7 puis en E8
jusqu'à 31 jours (E37), et en F1 pour l'après-midi (c'est à dire
qu'à chaque validation l'image irai en cellule F6 puis en F7 puis en
F8jusqu'à 31 jours (F37).



--
Cordialement
Guy
"Daniel.C" a écrit dans le message de
news:
Dis voir les colonnes que tu veux utiliser pour les listes de
validation et pour les images.
Daniel

Oui sait ce que je voulais!!!
Cela me fais penser à autre chose.
Si je fais ça pour une journée, est-il possible sur la même
feuille de faire ç par 1/2 journée ?
Matin image en colonne F.
Après-midi en colonne G.
Je suppose avec une 2ème liste déroulante ?
Mais au niveau du code..........?
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
http://cjoint.com/?lzoZh1jB23
Daniel

Non, ça peut être 6,7,8,9,10,11 jusqu'à 31 jours
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
T'es bien sûr que c'est 6, 9, 11, 13 ? t'arranges pas mes
affaires !
Daniel

Ok ça fonctionne seulement pour avoir.
D6(Texte liste déroulante)et F6(résultat image suivant le
choix de D6).Ok

Mais si je souhaiterais avoir la même chose dans les cellules
en dessous.
D9(Texte liste déroulante) et F9(résultat image suivant le
choix de D9).
D11(Texte liste déroulante) et F11(résultat image suivant le
choix de D11).
etc.........
Pour ça les images doivent rester en place.
--
Cordialement
Guy

"Daniel.C" a écrit dans le message
de news:
Ou plutôt cette syntaxe :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
On Error Resume Next
ActiveSheet.Shapes("toto").Delete
On Error GoTo 0
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Selection.ShapeRange.Name = "toto"
End If
End Sub

Daniel


Au temps ppour moi.
Remplace la macro par :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
ActiveSheet.Shapes(Shapes.Count).Delete
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
End If
End Sub

(le nom des images est en A6 et plus bas). J'ai ajouté le
delete de l'image précédente, en fait, la dernière collée
sur la feuille. Fais donc attention si tu en ajoutes.
Daniel

Bonjour,
D'accord ça fonctionne avec des noms différent dans le
code.
La liste déroulante me conviens bien.
Il faut donc que je copie autant de fois le code que noms
différents "ActiveSheet.Shapes.Range("Pluie").Select" et de
cellules différentes "If Target.Address = "$D$6" Then" et
"Range("F6").Select"?
Exemple : Texte D6 Image F6, Texte D7 Image F7, Texte D8
Image F8, etc......
Merci de votre aide




















































Avatar
Guy72
Bonjour Daniel,
Quand je mets ma liste à l'horizontale ,ça ne fonctionne plus.
Que faut-il modifier ?
Merci de ton aide;
--
Cordialement
Guy

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

D'accord.
Je suppose...... que le nom "début" peut être supprimé ?
Je suppose aussi........que le module "test" peut être supprimé également
?
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de news:
%
Voila, avecune plage dynamique :
http://www.cijoint.fr/cjlink.php?file=cj200912/cijnlvd3gw.xls
Daniel

Pas possible, si je la supprime, ça ne fonctionne plus.
Il me semble qu'elle est aussi dans ton code "image =
Application.Index([A6:A30], Application.Match(Target, [A6:A30], 0), 1)"
--
Cordialement
Guy

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

Juste un oubli...
Daniel

Ok c'est parfait.
Mais encore une petite question.
A quoi sert la liste en colonne A ?
--
Cordialement
Guy

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

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row <> 1 Then Exit Sub
Application.EnableEvents = False
image = Application.Index([A6:A30], Application.Match(Target,
[A6:A30], 0), 1)
If Target.Column = 5 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 5).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 5).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
.Left = Cells(i, 5).Left
.Top = Cells(i, 5).Top
End With
ElseIf Target.Column = 6 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 6).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 6).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
.Left = Cells(i, 6).Left
.Top = Cells(i, 6).Top
End With
End If
Application.EnableEvents = True
End Sub

Daniel

C'est tout à fait ça.
Pour l'instant le seul problème que je trouve ç' est l'emplacement
des image,elle ne se mette pas en haut à gauche de la cellule.
Comment peut-on avoir les image toujours dans le même alignement.
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
Teste le classeur suivant :
http://cjoint.com/?lztWd1zHsz
(je m'absente pour une dizaine de jours; relance le forum en cas
de besoin).
Daniel

En colonne B les cellules de validation du matin.
En colonne C les cellules de validation de l'après -midi.
En colonne E les images du matin.
En colonne F les images de l'après-midi.
La liste, n'importe ou en dessous de la ligne 40 ou en colonne N.
Si ?c'est possible? de faire qu'une cellule de validation pour
chaque partie les mettre en E1 pour le matin (c'est à dire qu'à
chaque validation l'image irai en cellule E6 puis en E7 puis en
E8 jusqu'à 31 jours (E37), et en F1 pour l'après-midi (c'est à
dire qu'à chaque validation l'image irai en cellule F6 puis en F7
puis en F8jusqu'à 31 jours (F37).



--
Cordialement
Guy
"Daniel.C" a écrit dans le message de
news:
Dis voir les colonnes que tu veux utiliser pour les listes de
validation et pour les images.
Daniel

Oui sait ce que je voulais!!!
Cela me fais penser à autre chose.
Si je fais ça pour une journée, est-il possible sur la même
feuille de faire ç par 1/2 journée ?
Matin image en colonne F.
Après-midi en colonne G.
Je suppose avec une 2ème liste déroulante ?
Mais au niveau du code..........?
--
Cordialement
Guy

"Daniel.C" a écrit dans le message
de news:
http://cjoint.com/?lzoZh1jB23
Daniel

Non, ça peut être 6,7,8,9,10,11 jusqu'à 31 jours
--
Cordialement
Guy

"Daniel.C" a écrit dans le message
de news:
T'es bien sûr que c'est 6, 9, 11, 13 ? t'arranges pas mes
affaires !
Daniel

Ok ça fonctionne seulement pour avoir.
D6(Texte liste déroulante)et F6(résultat image suivant le
choix de D6).Ok

Mais si je souhaiterais avoir la même chose dans les
cellules en dessous.
D9(Texte liste déroulante) et F9(résultat image suivant le
choix de D9).
D11(Texte liste déroulante) et F11(résultat image suivant
le choix de D11).
etc.........
Pour ça les images doivent rester en place.
--
Cordialement
Guy

"Daniel.C" a écrit dans le
message de news:
Ou plutôt cette syntaxe :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
On Error Resume Next
ActiveSheet.Shapes("toto").Delete
On Error GoTo 0
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Selection.ShapeRange.Name = "toto"
End If
End Sub

Daniel


Au temps ppour moi.
Remplace la macro par :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
ActiveSheet.Shapes(Shapes.Count).Delete
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
End If
End Sub

(le nom des images est en A6 et plus bas). J'ai ajouté le
delete de l'image précédente, en fait, la dernière collée
sur la feuille. Fais donc attention si tu en ajoutes.
Daniel

Bonjour,
D'accord ça fonctionne avec des noms différent dans le
code.
La liste déroulante me conviens bien.
Il faut donc que je copie autant de fois le code que
noms différents
"ActiveSheet.Shapes.Range("Pluie").Select" et de
cellules différentes "If Target.Address = "$D$6" Then"
et "Range("F6").Select"?
Exemple : Texte D6 Image F6, Texte D7 Image F7, Texte D8
Image F8, etc......
Merci de votre aide
























































Avatar
Daniel.C
Bonjour.
Regarde :
http://cjoint.com/?mpmZ1SObKy
Daniel

Bonjour Daniel,
Quand je mets ma liste à l'horizontale ,ça ne fonctionne plus.
Que faut-il modifier ?
Merci de ton aide;
--
Cordialement
Guy

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

D'accord.
Je suppose...... que le nom "début" peut être supprimé ?
Je suppose aussi........que le module "test" peut être supprimé également
?
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de news:
%
Voila, avecune plage dynamique :
http://www.cijoint.fr/cjlink.php?file=cj200912/cijnlvd3gw.xls
Daniel

Pas possible, si je la supprime, ça ne fonctionne plus.
Il me semble qu'elle est aussi dans ton code "image =
Application.Index([A6:A30], Application.Match(Target, [A6:A30], 0), 1)"
--
Cordialement
Guy

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

Juste un oubli...
Daniel

Ok c'est parfait.
Mais encore une petite question.
A quoi sert la liste en colonne A ?
--
Cordialement
Guy

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

Essaie ce code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ResAdr As String
If Target.Row <> 1 Then Exit Sub
Application.EnableEvents = False
image = Application.Index([A6:A30], Application.Match(Target,
[A6:A30], 0), 1)
If Target.Column = 5 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 5).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 5).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 5).Address(0, 0))
.Left = Cells(i, 5).Left
.Top = Cells(i, 5).Top
End With
ElseIf Target.Column = 6 Then
For i = 6 To 37
On Error Resume Next
Set Sh = ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
If Err.Number <> 0 Then
Err.Clear
ActiveSheet.Shapes.Range(image).Select
Selection.Copy
Cells(i, 6).Select
ActiveSheet.Paste
Selection.ShapeRange.Name = (Cells(i, 6).Address(0, 0))
On Error GoTo 0
Exit For
End If
Next i
With ActiveSheet.Shapes(Cells(i, 6).Address(0, 0))
.Left = Cells(i, 6).Left
.Top = Cells(i, 6).Top
End With
End If
Application.EnableEvents = True
End Sub

Daniel

C'est tout à fait ça.
Pour l'instant le seul problème que je trouve ç' est l'emplacement
des image,elle ne se mette pas en haut à gauche de la cellule.
Comment peut-on avoir les image toujours dans le même alignement.
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
Teste le classeur suivant :
http://cjoint.com/?lztWd1zHsz
(je m'absente pour une dizaine de jours; relance le forum en cas de
besoin).
Daniel

En colonne B les cellules de validation du matin.
En colonne C les cellules de validation de l'après -midi.
En colonne E les images du matin.
En colonne F les images de l'après-midi.
La liste, n'importe ou en dessous de la ligne 40 ou en colonne N.
Si ?c'est possible? de faire qu'une cellule de validation pour
chaque partie les mettre en E1 pour le matin (c'est à dire qu'à
chaque validation l'image irai en cellule E6 puis en E7 puis en E8
jusqu'à 31 jours (E37), et en F1 pour l'après-midi (c'est à dire
qu'à chaque validation l'image irai en cellule F6 puis en F7 puis
en F8jusqu'à 31 jours (F37).



--
Cordialement
Guy
"Daniel.C" a écrit dans le message de
news:
Dis voir les colonnes que tu veux utiliser pour les listes de
validation et pour les images.
Daniel

Oui sait ce que je voulais!!!
Cela me fais penser à autre chose.
Si je fais ça pour une journée, est-il possible sur la même
feuille de faire ç par 1/2 journée ?
Matin image en colonne F.
Après-midi en colonne G.
Je suppose avec une 2ème liste déroulante ?
Mais au niveau du code..........?
--
Cordialement
Guy

"Daniel.C" a écrit dans le message de
news:
http://cjoint.com/?lzoZh1jB23
Daniel

Non, ça peut être 6,7,8,9,10,11 jusqu'à 31 jours
--
Cordialement
Guy

"Daniel.C" a écrit dans le message
de news:
T'es bien sûr que c'est 6, 9, 11, 13 ? t'arranges pas mes
affaires !
Daniel

Ok ça fonctionne seulement pour avoir.
D6(Texte liste déroulante)et F6(résultat image suivant le
choix de D6).Ok

Mais si je souhaiterais avoir la même chose dans les
cellules en dessous.
D9(Texte liste déroulante) et F9(résultat image suivant le
choix de D9).
D11(Texte liste déroulante) et F11(résultat image suivant le
choix de D11).
etc.........
Pour ça les images doivent rester en place.
--
Cordialement
Guy

"Daniel.C" a écrit dans le
message de news:
Ou plutôt cette syntaxe :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
On Error Resume Next
ActiveSheet.Shapes("toto").Delete
On Error GoTo 0
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Selection.ShapeRange.Name = "toto"
End If
End Sub

Daniel


Au temps ppour moi.
Remplace la macro par :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$6" Then
Image = Application.Index([A6:A30],
Application.Match(Target, [A6:A30], 0), 1)
ActiveSheet.Shapes(Shapes.Count).Delete
ActiveSheet.Shapes.Range(Image).Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
End If
End Sub

(le nom des images est en A6 et plus bas). J'ai ajouté le
delete de l'image précédente, en fait, la dernière collée
sur la feuille. Fais donc attention si tu en ajoutes.
Daniel

Bonjour,
D'accord ça fonctionne avec des noms différent dans le
code.
La liste déroulante me conviens bien.
Il faut donc que je copie autant de fois le code que noms
différents "ActiveSheet.Shapes.Range("Pluie").Select" et
de cellules différentes "If Target.Address = "$D$6" Then"
et "Range("F6").Select"?
Exemple : Texte D6 Image F6, Texte D7 Image F7, Texte D8
Image F8, etc......
Merci de votre aide


























































1 2 3