XL 2016 Bouton sélecteur d'image dans Excel

[Leyhan]

Bonjour à tous,

Je suis en pleine recherche, depuis 2 jours, d'une solution à mon problème. Je ne suis pas une pro d'Excel.

Voici ce que je souhaiterais :
Avoir un bouton qui ouvre le sélecteur de documents pour sélectionner une image.

J'ai une BDD qui est remplie par nos commerciaux. Pour alimenter cette BDD, nous souhaitons ajouter 3 photos du projet par client. Et pour leur faciliter le remplissage, j'aurais aimé 3 boutons "Insérer photo 1" "Insérer photo 2" "Insérer photo 3" par exemple.

Je ne sais pas si ma demande est claire.

Merci d'avance pour votre aide !

 

[sousou]

Bonjour
Sans précision sur le fichier, le principe:
Sub bouton()
ChDir ("C:\Users\Utilisateur\Pictures") 'ici le dossier contenat les images
image = Application.GetOpenFilename("image(*.jpg), *.jpg", 1, " Chargement d'une image")
Set img = ActiveSheet.Pictures.Insert(image)
With img 'ici positionnement des images
img.Width = 100
img.Left = 100
img.Top = 100
End With
End Sub

 

[Leyhan]

Bonjour,

Merci beaucoup pour votre réponse.

Au risque de paraître quiche en Excel, c'est la première fois que je fais quelque chose comme ça :

Dans le menu Développeur j'ai créer un "Bouton". Ensuite, je vais dans visualiser le code.

J'ai rentré :
Sub bouton()
ChDir ("C:\Users\boursc\Desktop\CLUBCVC")
image = Application.GetOpenFilename("image(*.jpg), *.jpg", 1, " Chargement d'une image")
Set img = ActiveSheet.Pictures.Insert(image)
With img
img.Width = 100
img.Left = 100
img.Top = 100
End With
End Sub

Et ensuite ?

Quand je retourne sur mon document ça me met le message d'erreur suivant : "Impossible d'exécuter la macro ".....". Il est possible qu'elle ne soit pas disponible dans ce classeur ou que toutes les macros soient désactivées."

Merci d'avance !

 

[jcf6464]

Bonjour [U]sousou, [/U]Leyhan et le forum,

Sousou à dis (Sans précision sur le fichier, le principe: )

le principe: c'est d'avoir un fichier c'est plus rapide que de faire un morceau de code à la va-vite,

bonne continuation

jcf

 

[sousou]

Peut être un probléme de sécurité si vous n avez jamais utilisé de macro
Pouvez vous envoyer le fichier afin de vous montrer la procédure

 

[Leyhan]

Bonjour,

Merci pour vos réponses.

Voici mon document.

Pour l'instant, j'ai ces colonnes qui mettent le lien vers les photos (pour publipostage Word par la suite).

Merci d'avance

 

[sousou]

Format du fichier en xlsm,(acceptant les macro)
la procédure va installer l'image choisie dans la cellule ou ce trouve le bouton
A étudier
remet le chemin de tes images

 

[Leyhan]

Merci beaucoup pour votre aide Sousou !!!

Est-ce que vous savez s'il serait possible d'insérer (avec le même principe) le chemin/lien de l'image au lieu de la photo elle même ? (Il me faudrait les 2 si possible...)

 

[patricktoulon]

re
bonjour a tous
sans être un proet juste en en réfléchissant on se rend compte qu il y a un soucis
ca vous parait cohérent cela

On Error Resume Next 'traitement si l'image existe alors on l'efface
    ActiveSheet.Shapes(b & "img").Delete
    If Err.Number = 0 Then ActiveSheet.Shapes(b & "img").Delete
On Error GoTo 0       '______________________________________________

 

[sousou]

patrick boff!
Si l'image existe il l'efface si non il passe l'erreur

 

[sousou]

comme ceci peut-être
Sub bouton()
ChDir ("C:\Users\Utilisateur\Pictures") 'ici le dossier contenat les images
b = Application.Caller 'renvoi le nom bouton appelant
On Error Resume Next 'traitement si l'image existe alors on l'efface
ActiveSheet.Shapes(b & "img").Delete
If Err.Number = 0 Then ActiveSheet.Shapes(b & "img").Delete
On Error GoTo 0 '______________________________________________
Set b = ActiveSheet.Shapes(b) 'definit l'objet bouton
Set cel = b.TopLeftCell ' renvoi la cellule associée à ce bouton

image = Application.GetOpenFilename("image(*.jpg), *.jpg", 1, " Chargement d'une image") 'choix de l'image
cel.Value = image
Set img = ActiveSheet.Pictures.Insert(image) 'insertion de l'image
With img 'position de l'image

img.Width = cel.Width - b.Width 'largeur = largeur de la cellule - largeur du bouton
img.Left = cel.Left + b.Width 'position gauche de l'image
img.Name = b.Name & "img" 'défintion du nom de l'image
img.Top = cel.Offset(1, 0).Top
End With
End Sub

 

[patricktoulon]

patrick boff!
Si l'image existe il l'efface si non il passe l'erreur

heu.... tu es sur !!!!!!????,?
non ! si je traduit le code ca donne
On Error Resume Next 'en cas d'erreur continue
ActiveSheet.Shapes(b & "img").Delete 'supprime l'image
If Err.Number = 0 Then ActiveSheet.Shapes(b & "img").Delete' si il n'y a pas d'erreur (donc l'image y etait et a été supprimée) supprimer a nouveau l'image
On Error GoTo 0 '______________________________________________

ding dong A l'hôpital!!!!!!!!!!!
nonmais sans blague

On Error Resume Next 'en cas d'erreur continue
    ActiveSheet.Shapes(b & "img").Delete
On Error GoTo 0'vide le stack d'erreur

et basta ca suffit
LOL