Resim kalitesi bozulmadan resim oluşturmak

[Muhammet Okumuş]

Arkadaşlar merhaba.

Sub Resim()
Dim rng As Excel.Range
Dim cht As Excel.ChartObject

Application.ScreenUpdating = False

Set rng = Range("W3:AL20")
rng.CopyPicture xlScreen, xlPicture
Set cht = ActiveSheet.ChartObjects.Add(45, 15, rng.Width * 2, rng.Height * 2)
cht.Chart.Paste
cht.Border.LineStyle = 0


ExitProc:
Application.ScreenUpdating = True
Set cht = Nothing
Set rng = Nothing
End Sub

kod yardımıyla belirli aralığın resmini aktarabiliyorum.(Kod alıntıdır)
Ama oluşturulan resmin kalitesi çok iyi değil. Ekran görüntüsü olarak Faststone programını kullanıyorum. O program çok net aktarıyor.

Acaba resim kalitesini arttıracak başka kod var mı? veya Faststone programı Excel'e entegre edilebilir mi?

 

[Zeki Gürsoy]

Bu biraz da resim ebatlarıyla alakalı.
Örneğin; w3:al20 aralığını elle resim olarak yapıştırsanız, kendi ebatlarında resim bir resim belirecektir. Eğer ebatlarını elle iki veya daha fazla katına kadar büyütürseniz öyle bozulacaktır ki, neredeyse pixellerini bile görmeniz mümkün.
Ben Set cht = ActiveSheet.ChartObjects.Add(45, 15, rng.Width * 2, rng.Height * 2) satırından bunu anlıyorum.

 

[Muhammet Okumuş]

Zeki Bey cevabınız için teşekkür ederim.
Oradaki değerleri ben değiştirdim. Ama *2 yapmak ile yapmamak arasında hiç fark yok. Çünkü değerleri değiştirseniz bile resmi "chart" dediğimiz grafik alanına döşemiyor. Görsel ikisinin de görünümünü paylaştım. "chart" olayını daha önce dışarı (klasöre) resim oluşturmak için kullanıyordum
Kopyala dediğimiz alanı resim olarak yapıştırmayı sizin mesajınızdan sonra öğrendim. Bu özelliği mutlaka görmüşümdür. Ama hiç ilgi alanıma girmediği için dikkatimi çekmemiş demek ki.
Bu resim olarak kopyalamayı öğrendikten sonra tam olmasa da görüntü istediğim düzeye yakın. Kayda değer ilerleme kaydedersem paylaşırım.

Zeki Bey cevabınız için tekrardan çok teşekkür ederim.