Selam Arkadaşlar,
Belirli bir alandaki tanımlanmış hücreleri resim olarak belirli bir hedefe belirli bir isimde kaydetmeyi sitede aradım ancak ya hata ile yada boş beyaz bir sayfa ile karşılaştım.
Bu sebepten dolayı globalde bir arama yaparak bir iki kodu birleştirerek bir çalışma yaptım. benim gibi hata ile karşılaşan arkadaşlar olursa faydalansın diyerek buradan paylaşmak istedim.
Belirli bir alandaki tanımlanmış hücreleri resim olarak belirli bir hedefe belirli bir isimde kaydetmeyi sitede aradım ancak ya hata ile yada boş beyaz bir sayfa ile karşılaştım.
Bu sebepten dolayı globalde bir arama yaparak bir iki kodu birleştirerek bir çalışma yaptım. benim gibi hata ile karşılaşan arkadaşlar olursa faydalansın diyerek buradan paylaşmak istedim.
Kod:
Option Explicit
Sub Resim_Kaydet()
Dim oWs As Worksheet
Dim oRng As Range
Dim oChrtO As ChartObject
Dim lWidth As Long, lHeight As Long
Set oWs = ActiveSheet
Set oRng = oWs.Range("B2:I66") 'kaydedilecek hedef hücreler
oRng.CopyPicture xlScreen, xlPicture
lWidth = oRng.Width
lHeight = oRng.Height
Set oChrtO = oWs.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, Height:=lHeight)
oChrtO.Activate
With oChrtO.Chart
.Paste
.Export Filename:="C:\EXCEL\" & Sheets("ISI FORMU").Range("C6").Value & "_" & Sheets("ISI FORMU").Range("F6").Value & ".jpg", Filtername:="JPG" 'Dosyayı Kaydedeceği Hedef (ISI FORMU sayfa adıdır) C6 ve F6 hücrelerindeki verileri dosya adına yazarak kaydeder.
End With
oChrtO.Delete
'Seçili alanı kaydettikten sonra yazdırmak isterseniz aşağıdaki bölümün tırnaklarını kaldırın.
'ActiveSheet.PageSetup.PrintArea = "B2:I66"
'ActiveSheet.PrintOut
End Sub