İyi Günler;
Aşağıdaki farklı kodlarla resim getirmekteyim. Ancak, resimlerin G7 hücresinin boyutuna göre olması için kodlarda ne gibi değişiklik yapılması gerekmektedir.
Dim resimler As Object
ActiveSheet.DrawingObjects.Delete
ActiveSheet.Pictures.Insert ThisWorkbook.Path & "\" & "Resimler\" & Range("$D$7") & ".jpg", Range("G7")
Set resimler = ActiveSheet.DrawingObjects
resimler.ShapeRange.Width = 285
resimler.ShapeRange.Top = 100
resimler.ShapeRange.Left = 270
Set resimler = Nothing
isim = Range("D7").Text
klsr = ThisWorkbook.Path & "\" & "Resimler\"
aa = klsr & "\" & isim & ".jpg"
Set evn = CreateObject("Scripting.FileSystemObject")
For Each dosya In evn.GetFolder(klsr).Files
uznt = Split(dosya.Name, ".")(1)
ad = Split(dosya.Name, ".")(0)
If isim = ad Then
If UCase(uznt) = "JPG" Then
With ActiveSheet.Pictures.Insert(aa)
.Left = [G7].Left
.Top = [G7].Top
.Width = [G7].Width * 2
.Height = [G7].Height * 11
End With
End If
End If
Next
Aşağıdaki farklı kodlarla resim getirmekteyim. Ancak, resimlerin G7 hücresinin boyutuna göre olması için kodlarda ne gibi değişiklik yapılması gerekmektedir.
Dim resimler As Object
ActiveSheet.DrawingObjects.Delete
ActiveSheet.Pictures.Insert ThisWorkbook.Path & "\" & "Resimler\" & Range("$D$7") & ".jpg", Range("G7")
Set resimler = ActiveSheet.DrawingObjects
resimler.ShapeRange.Width = 285
resimler.ShapeRange.Top = 100
resimler.ShapeRange.Left = 270
Set resimler = Nothing
isim = Range("D7").Text
klsr = ThisWorkbook.Path & "\" & "Resimler\"
aa = klsr & "\" & isim & ".jpg"
Set evn = CreateObject("Scripting.FileSystemObject")
For Each dosya In evn.GetFolder(klsr).Files
uznt = Split(dosya.Name, ".")(1)
ad = Split(dosya.Name, ".")(0)
If isim = ad Then
If UCase(uznt) = "JPG" Then
With ActiveSheet.Pictures.Insert(aa)
.Left = [G7].Left
.Top = [G7].Top
.Width = [G7].Width * 2
.Height = [G7].Height * 11
End With
End If
End If
Next
