Colonne d'image BMP

[Pascal]

Bonjour à tous,

Je voudrais savoir s'il est possible avec excel de faire correspondre une image dans une cellule avec son nom de fichier; je m'explique:

Dans chaque cellule de la colonne A j'ai des numéros de fichiers BMP (par exemple 1001,1002,1003,XXXX,... sans l'extension .BMP) qui sont des fichiers venant par exemple du répertoire C:\Mes documents\DAO et je voudrais avoir dans chaque cellule de la colonne B l'image des dessins correspondant au nom des fichiers de la colonne A.

J'ai plusieurs centaines de fichiers à traiter avec d'autres données dans les autres colonnes (Longueur, Largeur, Poids, Périmètre, etc...) et je voudrais trier ces données et les imprimer avec leur dessin , d'ou ma question ?

Merci, par avance à tous ceux qui se pencheront sur le problème.

 

[Robert]

Salut Pascal, le forum,

Voici une macro qui ne fonctionnera que si toutes les images sont dans le dossier que tu as cité en exemple. Sinon il te faudra l'adapter.

J'ai ajusté l'image par rapport à la hauteur de la cellule mais tu peux le faire par rapport à la largeur si tu le veux.

Public Sub insertion()
Dim chem As String
chem = "C:\Mes documents\DAO\" '(à adapter)
For Each cel In Range("A1:A" & Range("A65536").End(xlUp).Row)
haut = cel.Offset(0, 1).Top
gauche = cel.Offset(0, 1).Left
Large = cel.Offset(0, 1).Width
haute = cel.Offset(0, 1).Height
ActiveSheet.Pictures.Insert(chem & cel.Value & ".jpg").Select
With Selection
.Top = haut
.Left = gauche
.ShapeRange.LockAspectRatio = msoTrue
'pour changer l'ajustement inverser les apostrophes
.ShapeRange.Height = haute 'ajustée à la hauteur
'.ShapeRange.Width = large 'ajuster à la largeur
End With
cel.Select
Next cel
End Sub

À plus,

Robert

 

[Robert]

Re salut,

je m'étions planté... Il faut remplacer la ligne :

ActiveSheet.Pictures.Insert(chem & cel.Value & ".jpg").Select

par
ActiveSheet.Pictures.Insert(chem & cel.Value & ".bmp").Select

À plus,

Robert

 

[Pascal]

Merci Robert pour la réponse rapide, c'est parfait

Moi qui suis débutant au niveau des macros, je m'étonne de ce que l'on peut faire avec quelques lignes d'instructions "bien placées" !!!

Je me suis rendu compte d'un petit problème que tu ne pouvais pas prévoir
Dans mon cas les N° de fichiers sont issus d'une base de donnée et sont exportées vers excel avec des requêtes via Msquerry et sont donc soumis à des actualisations.

Tout ceci pour dire que lorsque je relance la macro les images nouvelles se superposent aux anciennes dans les cellules.
Comment peut-on intégrer dans la macro une séquence en début qui efface toutes les images de la feuille avant d'intégrer les nouvelles.

Et je voudrais savoir en parallèle, s'il y a dans les menus d'excel une fonction qui permet d'effacer toutes les images en même temps dans une feuille de calcul (à part les effacer une par une, ce qui est un peu long dans mon cas...)

Merci par avance

 

[Robert]

Resalut Pascal , salut le forum,

Rajoute ces quelques lignes au début du code (seconde ligne)


Dim sh As Shape
For Each sh In ActiveSheet.Shapes
sh.Delete
Next sh

Tu peux aussi créé avec ce code la macro dont tu parles. Il te faudra l'enregistrer dans le classeur de démarrage d'Excel si tu veux qu'elle soit active pour tous les classeurs.

À plus,

Robert

 

[arnaud]

Super ces astuces pour effacer les images !!
Top cool !

Je souhaiterai pouvoir inserer une image à un endroit précis (milieu de la cellule B2).
Quel code dois-je écrire ??

Merci d'avance...
Arnaud

 

[Robert]

Salut Arnaud, le forum,

Marrant de revenir sur un post de presque un mois...

Sélectionne ton image et lance la macro ci-dessous

Sub Macro1()
Dim celgau As Double, celtop As Double, cellarg As Double, celhaut As Double
Dim imghaut As Double, imglarg As Double
Dim cel As Range
Set cel = Range("B2")
celgau = cel.Left
celtop = cel.Top
cellarg = cel.Width
celhaut = cel.Height
With Selection
imglarg = .Width
imghaut = .Height
.Left = celgau + ((cellarg - imglarg) / 2)
.Top = celtop + ((celhaut - imghaut) / 2)
End With
End Sub

À plus,

Robert

 

[arnaud]

Merci pour tout !
Arnaud