mars2
Altın Üye
- Katılım
- 2 Eylül 2004
- Mesajlar
- 600
- Excel Vers. ve Dili
-
2016 - Türkçe
2019 - Türkçe
- Altın Üyelik Bitiş Tarihi
- 26-03-2026
İ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
