C dizininde Deneme isimli bir klasör oluşturun ve kodu çalıştırın.
Kod:
Sub ResimleriDisaAktar()
For i = 1 To ActiveSheet.Shapes.Count
strImageName = ActiveSheet.Cells(ActiveSheet.Shapes(i).TopLeftCell.Row, 2).Value
ActiveSheet.Shapes(i).Select
Selection.CopyPicture
Set oDia = ActiveSheet.ChartObjects.Add(0, 0, ActiveSheet.Shapes(i).Width, ActiveSheet.Shapes(i).Height)
Set oChartArea = oDia.Chart
oDia.Activate
With oChartArea
.ChartArea.Select
.Paste
.Export ("C:\Deneme\" & strImageName & ".jpg")
End With
oDia.Delete 'oChartArea.Delete
Next
End Sub
Sizlere daha iyi bir deneyim sunabilmek icin sitemizde çerez konumlandırmaktayız, web sitemizi kullanmaya devam ettiğinizde çerezler ile toplanan kişisel verileriniz Veri Politikamız / Bilgilendirmelerimizde belirtilen amaçlar ve yöntemlerle mevzuatına uygun olarak kullanılacaktır.