Bonjour à tous,
j'essaye depuis des semaines à faire correspondre une case d'une feuille excel à une image contenu dans un fichier. Je m'explique:
Article (a1) Miniature(b1)
Accroche Poids Crantée(a2) case vide (b2)
Accroche Poids Ronde (a3) etc....
Adoucisseur d'eau CTA
le fichier où se situe mes photos, s'intitule D:\Inventaire\Photos
DOnc j'aimerais grâce a une macro, afficher l'image (par exemple) de l'accroche poids crantée en case b2 ,
voici ma macro actuelle qui ne fonctionne pas :
Sub InserImage()
Dim i As Integer, j As Integer, path As String, sep As String, img As String
Dim objImg As Object
Dim Emplacement As Range
path = "D:\Inventaire\Photos\*"
For i = 1 To 1000
While Range("B2").Offset(i, 0) <> ""
j = j + 1
i = j
Wend
'If Dir(img) = "" Then Exit Sub"
ActiveSheet.Pictures.Insert(path & Range("A2").Offset(i, 0).Value & ".jpg").Select
Set Emplacement = Range("B2").Offset(i, 0)
Range("B2").Offset(i, 0).Value = "."
Set objImg = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
With objImg.ShapeRange
.LockAspectRatio = msoFalse
.Left = Emplacement.Left + 2
.Top = Emplacement.Top + 2
.Height = Emplacement.Height - 3.5
.Width = Emplacement.Width - 3.5
End With
Next
End Sub
Merci d'avance de vos réponses
j'essaye depuis des semaines à faire correspondre une case d'une feuille excel à une image contenu dans un fichier. Je m'explique:
Article (a1) Miniature(b1)
Accroche Poids Crantée(a2) case vide (b2)
Accroche Poids Ronde (a3) etc....
Adoucisseur d'eau CTA
le fichier où se situe mes photos, s'intitule D:\Inventaire\Photos
DOnc j'aimerais grâce a une macro, afficher l'image (par exemple) de l'accroche poids crantée en case b2 ,
voici ma macro actuelle qui ne fonctionne pas :
Sub InserImage()
Dim i As Integer, j As Integer, path As String, sep As String, img As String
Dim objImg As Object
Dim Emplacement As Range
path = "D:\Inventaire\Photos\*"
For i = 1 To 1000
While Range("B2").Offset(i, 0) <> ""
j = j + 1
i = j
Wend
'If Dir(img) = "" Then Exit Sub"
ActiveSheet.Pictures.Insert(path & Range("A2").Offset(i, 0).Value & ".jpg").Select
Set Emplacement = Range("B2").Offset(i, 0)
Range("B2").Offset(i, 0).Value = "."
Set objImg = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
With objImg.ShapeRange
.LockAspectRatio = msoFalse
.Left = Emplacement.Left + 2
.Top = Emplacement.Top + 2
.Height = Emplacement.Height - 3.5
.Width = Emplacement.Width - 3.5
End With
Next
End Sub
Merci d'avance de vos réponses