Photo selon valeur de cellule

Bonjour,

Je fais appel à vous... encore

J'ai dans ma feuille en C2 une valeur qui changera régulièrement

En F2, c'est le chemin menant à la photo sur le disque dur, ce chemin est assemblé via une formule qui inclus la valeur de C2

En H19 c'est la que je souhaiterais que la photo s'affiche automatiquement

Donc. si la valeur en C2 change, la photo changerais en fonction du nouveau chemin qui se ferait en F2

Si la valeur en C2 n'a aucune photo qui lui est associé, il pourrait y avoir une photo par défaut (exemple: c:\Image\NoPicture.jpg)

Je ne souhaite pas utiliser de macro ou bouton ou autre...

merci d'avance pour votre aide... précieuse

fichier joint

16ajoutphoto.xlsx (10.22 Ko)

bonjour

il me semble qu'il soit impossible d'importer un objet par formule => VBA obligatoire

cordialement

Bonjour Tulipe_4

C'est mon souhait de le faire en VBA

bonjour

il me semble qu'il soit impossible d'importer un objet par formule => VBA obligatoire

cordialement

Bonjour Mtek, Tulipe_4, le forum,

Je ne souhaite pas utiliser de macro ou bouton ou autre...

C'est mon souhait de le faire en VBA

Pas très clair tout ça.....

Sinon, j'avais ça dans mes archives:....tu pourrais t'en inspirer,

https://blog.partiprof.fr/afficher-image-suivant-valeur-cellule-excel/

Où encore

http://boisgontierjacques.free.fr/pages_site/lesimages.htm

Cordialement,

lollll ça sonnait plus clair dans ma tête, mais j'avoue qu'en me relisant....

Je souhaite le faire en VBA.... ce qui éviterait d'avoir un bouton sur ma page et aussi serait plus simple à l'usage pour les gens qui auront à travailler sur ce classeur, en VBA le traitement sera transparent pour les usagers...

En inscrivant ma valeur dans C2, s'il existe une photo correspondante dans le répertoire, elle s'affiche en H19, et si il n'y a pas de photo existante qui correspond à la valeur en C2, une image par défaut serait affiché.

merci encore de vous intéresser à mon problème

Bonjour Mtek, Tulipe_4, le forum,

Je ne souhaite pas utiliser de macro ou bouton ou autre...

C'est mon souhait de le faire en VBA

Pas très clair tout ça.....

Sinon, j'avais ça dans mes archives:....tu pourrais t'en inspirer,

https://blog.partiprof.fr/afficher-image-suivant-valeur-cellule-excel/

image-suivant-valeur-cellule-excel.xlsx

Où encore

http://boisgontierjacques.free.fr/pages_site/lesimages.htm

Cordialement,

Bon,

Ca fonctionne... presque

Voici ou j'en suis...

Lorsque je tape la valeur en C2, si une photo correspondante existe, elle s'affiche au bon endroit, mais ne s'ajuste pas au format de la shape

voici le code...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Image As Picture

Dim design As String

Dim c

Set c = Range("H19").MergeArea

On Error Resume Next

ActiveSheet.Shapes("PhotoShape").Delete

If Intersect(Target, Range("C2")) Is Nothing Then: Exit Sub

[H19].Select

design = ThisWorkbook.Path & "\" & [C2].Value & ".jpg"

Set Image = ActiveSheet.Pictures.Insert(design)

With Image.ShapeRange

.Name = "PhotoShape"

.Shapes(Name).Left = c.Left

.Shapes(Name).Top = c.Top

.Shapes(Name).LockAspectRatio = msoFalse

.Shapes(Name).Height = c.Height

.Shapes(Name).Width = c.Width

End With

[C2].Select

End Sub

pour ce fichier exemple, le fichier et une photo se retrouve dans le même répertoire

en mettant le nom du fichier (ex. test) fera apparaître la photo test.jpg dans la shape placé en H19

ne reste qu'a réduire la photo au format de la shape (et si possible en conservant le ratio de la photo)

merci de votre temps et votre aide

13ajoutphoto.xlsm (17.26 Ko)

Re,

En appliquant la méthode de mon post précédent.....sans macro....

Une feuille paramètres contenant les photos.

  • L' affichage en feuil1 est conditionné par la cellule B3 (ici une formule RechercheV qui affiche le N° correspondant à la lettre en D3).
  • D3 affiche une liste déroulante pour choisir une lettre qui conditionne le chiffre en B3.
12ajoutphoto.xlsx (342.65 Ko)

Cordialement,

Re,

A tester:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim design As String
Dim c As Range
Set c = Range("H19").MergeArea
On Error Resume Next
ActiveSheet.Shapes("PhotoShape").Delete
If Intersect(Target, Range("C2")) Is Nothing Then: Exit Sub
[H19].Select
design = ThisWorkbook.Path & "\" & [C2].Value & ".jpg"
With ActiveSheet
.Pictures.Insert(design).Name = "PhotoShape"
.Shapes(Name).Left = c.Left
.Shapes(Name).Top = c.Top
.Shapes(Name).LockAspectRatio = msoFalse
.Shapes(Name).Height = c.Height
.Shapes(Name).Width = c.Width

End With
[C2].Select
End Sub

Cordialement,

Malheureusement la photo n'est pas réduite au format de H19

je perd aussi la FORME (PhotoShape) mais apparemment ça ne semble pas causer de problème de ne pas avoir de FORME

merci de prendre du temps pour mon problème

Re,

A tester:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim design As String
Dim c As Range
Set c = Range("H19").MergeArea
On Error Resume Next
ActiveSheet.Shapes("PhotoShape").Delete
If Intersect(Target, Range("C2")) Is Nothing Then: Exit Sub
[H19].Select
design = ThisWorkbook.Path & "\" & [C2].Value & ".jpg"
With ActiveSheet
.Pictures.Insert(design).Name = "PhotoShape"
.Shapes(Name).Left = c.Left
.Shapes(Name).Top = c.Top
.Shapes(Name).LockAspectRatio = msoFalse
.Shapes(Name).Height = c.Height
.Shapes(Name).Width = c.Width

End With
[C2].Select
End Sub

Cordialement,

Je ne peux pas envisager ce genre de solution, j'ai 4 classeurs, et chacun a entre 1500 et 3000 dossiers contenant des photos...

Re,

En appliquant la méthode de mon post précédent.....sans macro....

Une feuille paramètres contenant les photos.

  • L' affichage en feuil1 est conditionné par la cellule B3 (ici une formule RechercheV qui affiche le N° correspondant à la lettre en D3).
  • D3 affiche une liste déroulante pour choisir une lettre qui conditionne le chiffre en B3.

AjoutPhoto.xlsx

Cordialement,

Re,

Je ne peux pas envisager ce genre de solution, j'ai 4 classeurs, et chacun a entre 1500 et 3000 dossiers contenant des photos...

Effectivement.....

Malheureusement la photo n'est pas réduite au format de H19

je perd aussi la FORME (PhotoShape) mais apparemment ça ne semble pas causer de problème de ne pas avoir de FORME

Cela fonctionne chez moi, mais je suis sous excel 2010,

Spoiler
capture

Je crains de ne pouvoir t'aider d'avantage,

Cordialement,

Si tu as une grande photo, elle se réduit au format de la cellule H19 ?

Re,

Cela fonctionne chez moi, mais je suis sous excel 2010,

Spoiler

Capture.JPG

Je crains de ne pouvoir t'aider d'avantage,

Cordialement,

Re,

Si tu as une grande photo, elle se réduit au format de la cellule H19 ?

Oui, comme tu peux le voir sur la capture d'écran de mon post précédent (clique sur afficher).

J'ai refais une nouvelle feuille avec ton code, et j'arrive au même résultat, la photo s'affiche beaucoup trop grande

je ne comprend pas !!!!

merci d'avoir prit du temps, c'est apprécié

Re,

Si tu as une grande photo, elle se réduit au format de la cellule H19 ?

Oui, comme tu peux le voir sur la capture d'écran de mon post précédent (clique sur afficher).

Re,

Attention, chez moi l'image est trop grande si:

.Pictures.Insert(design)
.Name = "PhotoShape"

Mais s'affiche correctement si

.Pictures.Insert(design).Name = "PhotoShape"

Voici une copie de mon code

.Pictures.Insert(design).Name = "PhotoShape"

.Shapes(Name).Left = c.Left

.Shapes(Name).Top = c.Top

.Shapes(Name).LockAspectRatio = msoFalse

.Shapes(Name).Height = c.Height

.Shapes(Name).Width = c.Width

et pourtant, la photo s'affiche a son plein format

Re,

Attention, chez moi l'image est trop grande si:

.Pictures.Insert(design)
.Name = "PhotoShape"

Mais s'affiche correctement si

.Pictures.Insert(design).Name = "PhotoShape"

Une dernière tentative....toujours fonctionnelle chez moi.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim design As String
Dim c As Range

 design = ThisWorkbook.Path & "\" & [C2].Value & ".jpg"

With ActiveSheet
 If Intersect(Target, .Range("C2")) Is Nothing Then: Exit Sub

 On Error Resume Next
   .Shapes("PhotoShape").Delete

 Set c = .Range("H19").MergeArea
   .Pictures.Insert(design).Name = "PhotoShape"
   .Shapes(Name).Left = c.Left
   .Shapes(Name).Top = c.Top
   .Shapes(Name).LockAspectRatio = msoFalse
   .Shapes(Name).Height = c.Height
   .Shapes(Name).Width = c.Width
   .Range("C2").Select
End With

End Sub

OUI, ça fonctionne parfaitement MERCIIIIIIIIIIIIIIIIIIII

Merci à toi, je te souhaite un excellent weekend

Une dernière tentative....toujours fonctionnelle chez moi.

Re,

OUI, ça fonctionne parfaitement MERCIIIIIIIIIIIIIIIIIIII

Bonne soirée,

Rechercher des sujets similaires à "photo valeur"