OVH Cloud OVH Cloud

Faire apparaître une image

15 réponses
Avatar
Poppy
Bonjour
En colonne A j'ai des noms.
en colonne B je met un "x" en face du nom au quel je veux que sa photo
apparaisse.
Je voudrais que la photo apparaisse en colonne C face au nom.
Je suppose qu'il faut que je mette toutes les images en Feuil2 par exemple ?
La formule en cellule C1....=SI(B1="x";Feuil2! image 1;"").
Cette formule là n'est pas bonne.
Quelqu'un peut-il me dire quel est la bonne formule ?
Merci de vôtre aide.
Cordialement
Poppy

5 réponses

1 2
Avatar
Poppy
Bonjour JB
J'ai pas du réussir à expliquer cela comme il faut.
Le prince est bon, ça me vas, mais......
Il faut que je puisse avoir un photo différente si j'ai deux "x".
Fichier joint
http://cjoint.com/?coleNx5GRb
Cordialement
Poppy


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

2 nouvelles versions:

http://boisgontierj.free.fr/fichiers/PhotoVisible2.xls

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 2 And Target.Count = 1 Then
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Address = Target.Offset(0, 1).Address Then
s.Visible = IIf(UCase(Target) = "X", True, False)
End If
Next s
End If
If Target.Column = 1 And Target.Count = 1 Then
If Target = "" Then
Target.Offset(0, 1) = ""
EffaceMentShape (Target.Offset(0, 2).Address)
Else
On Error Resume Next
EffaceMentShape (Target.Offset(0, 2).Address)
Sheets("photos").Shapes(Target).Copy
Target.Offset(0, 2).Select
ActiveSheet.Paste
Selection.Left = Target.Offset(0, 2).Left + 1
Selection.Top = Target.Offset(0, 2).Top + 1
Target.Offset(0, 1) = "X"
End If
End If
Application.EnableEvents = True
End Sub
Sub EffaceMentShape(c)
On Error Resume Next
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Address = c Then
s.Delete
End If
Next s
End Sub


http://boisgontierj.free.fr/fichiers/PhotoVisible3.xls

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 2 And Target.Count = 1 Then
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Address = Target.Offset(0, 1).Address Then
s.Visible = IIf(UCase(Target) = "X", True, False)
End If
Next s
End If
If Target.Column = 1 And Target.Count = 1 Then
If Target = "" Then
Target.Offset(0, 1) = ""
EffaceMentShape (Target.Offset(0, 2).Address)
Else
On Error Resume Next
EffaceMentShape (Target.Offset(0, 2).Address)
Sheets("Photos2").Shapes(1).Copy
Target.Offset(0, 2).Select
ActiveSheet.Paste
Selection.Left = Target.Offset(0, 2).Left + 1
Selection.Top = Target.Offset(0, 2).Top + 1
p = Application.Match(Target.Value, [Noms], 0)
y = "Photos2!" & Sheets("Photos2").Cells(p + 1, 2).Address
Selection.Formula = y
Selection.Name = Target.Row
Target.Offset(0, 1) = "X"
End If
End If
Application.EnableEvents = True
End Sub
Sub EffaceMentShape(c)
On Error Resume Next
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Address = c Then
s.Delete
End If
Next s
End Sub


JB



On 13 fév, 18:46, "Poppy" wrote:
Bonsoir JB
Oui je suis d'accord avec toi, je pige le truc, mais....
Par contre, je voudrais apporter une modification à ce que je voulais par
exemple :
En A1 j'inscrit (Avion)
En A2 j'inscrit (Voiture)
En A3 j'inscrit (Vélo)
etc........
Si je met un "x" en B1 je voudrais faire apparaître une image avec un
"avion".
Si je met un "x" en B2 je voudrais faire apparaître une image avec une
"voiture".
Si je met un "x" en B1 je voudrais faire apparaître une image avec un
"vélo".

Si je met un "x" en B1 et "x" en B3 je voudrais faire apparaître une image
avec un "avion et un vélo".

En fait, je voudrais avoir une image différente si je met "x" dans
plusieurs
cellules ?
Et aucune image si il n'y a pas de "x" ?
Est ce possible ?????
Cordialement
Poppy

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

Version simple:

http://cjoint.com/?cnqGgJ2MXr

Affiche une photo si X en colonne B
Les photos sont déjà en place dans la feuille en colonne C

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Count = 1 Then
Application.EnableEvents = False
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Address = Target.Offset(0, 1).Address Then
Shapes(s.Name).Visible = IIf(UCase(Target) = "X", True, False)
End If
Next s
Application.EnableEvents = True
End If
End Sub

JB

On 13 fév, 09:09, "Poppy" wrote:



Bonjour
En colonne A j'ai des noms.
en colonne B je met un "x" en face du nom au quel je veux que sa photo
apparaisse.
Je voudrais que la photo apparaisse en colonne C face au nom.
Je suppose qu'il faut que je mette toutes les images en Feuil2 par
exemple
?
La formule en cellule C1....=SI(B1="x";Feuil2! image 1;"").
Cette formule là n'est pas bonne.
Quelqu'un peut-il me dire quel est la bonne formule ?
Merci de vôtre aide.
Cordialement
Poppy- Masquer le texte des messages précédents -


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



Avatar
julienL
Bonjour,

Merci pour la réponse de anonymousA concernant la facon de renommer
les images.
Je viens d'essayer de parcourir la collection
activesheet.drawingobjects et en effet ca marche. On arrive à
"travailler" les images comme on le veut.

ci joint le code que j'ai utiliser en suivant l'aide.

For Each image In ActiveSheet.DrawingObject

With image.ShapeRange
.Name = "fyjk1"
.PictureFormat.Brightness = 0.8
.PictureFormat.Contrast = 1
.PictureFormat.ColorType = msoPictureAutomatic
.Rotation = 30
.IncrementLeft 70
.IncrementTop -50
.IncrementRotation 30
.Left = Range("A2", "C10").Left
.Top = Range("A2", "C10").Top
.Height = Range("A2", "C10").Height
.Width = Range("A2", "C10").Width
.Visible = False
.Visible = True
.Delete
End With

Next

Existe -t-il un classeur exemple de toutes les actions réalisables sur
une image?

Merci d'avance

Julien




On 13 fév, 20:21, anonymousA wrote:
Bonjour,

par défaut Excel affecte un nom à l'image, mais une fois créée, i l est
complètement possible de changer ce nom en parcourant la collection des
shapes ou des drawingobjects ( collection masquée).

A+


Avatar
anonymousA
A mon humble avis , il manque un s à DrawingObject dans For Each image
In ActiveSheet.DrawingObject.

Cordialement,

A+

On 14 fév, 15:43, "julienL" wrote:
Bonjour,

Merci pour la réponse de anonymousA concernant la facon de renommer
les images.
Je viens d'essayer de parcourir la collection
activesheet.drawingobjects et en effet ca marche. On arrive à
"travailler" les images comme on le veut.

ci joint le code que j'ai utiliser en suivant l'aide.

For Each image In ActiveSheet.DrawingObject

With image.ShapeRange
.Name = "fyjk1"
.PictureFormat.Brightness = 0.8
.PictureFormat.Contrast = 1
.PictureFormat.ColorType = msoPictureAutomatic
.Rotation = 30
.IncrementLeft 70
.IncrementTop -50
.IncrementRotation 30
.Left = Range("A2", "C10").Left
.Top = Range("A2", "C10").Top
.Height = Range("A2", "C10").Height
.Width = Range("A2", "C10").Width
.Visible = False
.Visible = True
.Delete
End With

Next

Existe -t-il un classeur exemple de toutes les actions réalisables sur
une image?

Merci d'avance

Julien

On 13 fév, 20:21, anonymousA wrote:



Bonjour,

par défaut Excel affecte un nom à l'image, mais une fois créée, il est
complètement possible de changer ce nom en parcourant la collection d es
shapes ou des drawingobjects ( collection masquée).

A+- Masquer le texte des messages précédents -


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



Avatar
JB
http://cjoint.com/?cop4wdtArc

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([B2:B65000], Target) Is Nothing And Target.Column =
2 And Target.Count = 1 Then
If Target = "" Then
EffaceMentShape Target.Offset(0, 5 + [B1]).Address
Else
On Error Resume Next
EffaceMentShape Target.Offset(0, 5 + [B1]).Address
CopyShape Target.Offset(0, Target).Address
Target.Offset(0, 5 + [B1]).Select
ActiveSheet.Paste
Target.Select
End If
End If
End Sub

Sub EffaceMentShape(c)
On Error Resume Next
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Address = c Then s.Delete
Next s
End Sub

Sub CopyShape(c)
On Error Resume Next
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Address = c Then s.Copy
Next s
End Sub

JB

On 14 fév, 11:05, "Poppy" wrote:
Bonjour JB
J'ai pas du réussir à expliquer cela comme il faut.
Le prince est bon, ça me vas, mais......
Il faut que je puisse avoir un photo différente si j'ai deux "x".
Fichier jointhttp://cjoint.com/?coleNx5GRb
Cordialement
Poppy

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

2 nouvelles versions:

http://boisgontierj.free.fr/fichiers/PhotoVisible2.xls

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 2 And Target.Count = 1 Then
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Address = Target.Offset(0, 1).Address Then
s.Visible = IIf(UCase(Target) = "X", True, False)
End If
Next s
End If
If Target.Column = 1 And Target.Count = 1 Then
If Target = "" Then
Target.Offset(0, 1) = ""
EffaceMentShape (Target.Offset(0, 2).Address)
Else
On Error Resume Next
EffaceMentShape (Target.Offset(0, 2).Address)
Sheets("photos").Shapes(Target).Copy
Target.Offset(0, 2).Select
ActiveSheet.Paste
Selection.Left = Target.Offset(0, 2).Left + 1
Selection.Top = Target.Offset(0, 2).Top + 1
Target.Offset(0, 1) = "X"
End If
End If
Application.EnableEvents = True
End Sub
Sub EffaceMentShape(c)
On Error Resume Next
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Address = c Then
s.Delete
End If
Next s
End Sub

http://boisgontierj.free.fr/fichiers/PhotoVisible3.xls

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 2 And Target.Count = 1 Then
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Address = Target.Offset(0, 1).Address Then
s.Visible = IIf(UCase(Target) = "X", True, False)
End If
Next s
End If
If Target.Column = 1 And Target.Count = 1 Then
If Target = "" Then
Target.Offset(0, 1) = ""
EffaceMentShape (Target.Offset(0, 2).Address)
Else
On Error Resume Next
EffaceMentShape (Target.Offset(0, 2).Address)
Sheets("Photos2").Shapes(1).Copy
Target.Offset(0, 2).Select
ActiveSheet.Paste
Selection.Left = Target.Offset(0, 2).Left + 1
Selection.Top = Target.Offset(0, 2).Top + 1
p = Application.Match(Target.Value, [Noms], 0)
y = "Photos2!" & Sheets("Photos2").Cells(p + 1, 2).Address
Selection.Formula = y
Selection.Name = Target.Row
Target.Offset(0, 1) = "X"
End If
End If
Application.EnableEvents = True
End Sub
Sub EffaceMentShape(c)
On Error Resume Next
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Address = c Then
s.Delete
End If
Next s
End Sub

JB

On 13 fév, 18:46, "Poppy" wrote:



Bonsoir JB
Oui je suis d'accord avec toi, je pige le truc, mais....
Par contre, je voudrais apporter une modification à ce que je voulais par
exemple :
En A1 j'inscrit (Avion)
En A2 j'inscrit (Voiture)
En A3 j'inscrit (Vélo)
etc........
Si je met un "x" en B1 je voudrais faire apparaître une image avec un
"avion".
Si je met un "x" en B2 je voudrais faire apparaître une image avec une
"voiture".
Si je met un "x" en B1 je voudrais faire apparaître une image avec un
"vélo".

Si je met un "x" en B1 et "x" en B3 je voudrais faire apparaître une image
avec un "avion et un vélo".

En fait, je voudrais avoir une image différente si je met "x" dans
plusieurs
cellules ?
Et aucune image si il n'y a pas de "x" ?
Est ce possible ?????
Cordialement
Poppy

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

Version simple:

http://cjoint.com/?cnqGgJ2MXr

Affiche une photo si X en colonne B
Les photos sont déjà en place dans la feuille en colonne C

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And Target.Count = 1 Then
Application.EnableEvents = False
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Address = Target.Offset(0, 1).Address Then
Shapes(s.Name).Visible = IIf(UCase(Target) = "X", True, Fal se)
End If
Next s
Application.EnableEvents = True
End If
End Sub

JB

On 13 fév, 09:09, "Poppy" wrote:

Bonjour
En colonne A j'ai des noms.
en colonne B je met un "x" en face du nom au quel je veux que sa photo
apparaisse.
Je voudrais que la photo apparaisse en colonne C face au nom.
Je suppose qu'il faut que je mette toutes les images en Feuil2 par
exemple
?
La formule en cellule C1....=SI(B1="x";Feuil2! image 1;"").
Cette formule là n'est pas bonne.
Quelqu'un peut-il me dire quel est la bonne formule ?
Merci de vôtre aide.
Cordialement
Poppy- Masquer le texte des messages précédents -


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


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




Avatar
julienL
En effet, il s'agit d'une erreur de frappe...
merci pour la correction

Cordialement

Julien
1 2