Resim Çek Yardım

[vivident]

Merhaba

Ekteki dosyada B2:J10 arasındaki hücrelerin resimlerini çekerek masaüstüne çıkarıyorum. Burada bir sorun yok. Lakin çözünürlüğü hep bozuk oluyor. jpeg yerine gif.'e çevirdim ama tam istediğim gibi olmadı

1) Koddaki şu çözünürlük satırı olan kısmı nasıl değiştirebiliriz. Yani B2:J10 hücreleri arasında hangi çözünürlükte kopyalıyorsa o çözünürlükte dışarı çıkarsın. Ben çözünürlüğünü oynamak istemiyorum

Set graf = ActiveSheet.ChartObjects.Add(1, 1, 350, 130).Chart

2) Birde resmi masaüstüne çıkarıyorum peki masaüstüne değilde aynı dosyada sayfa2'de A1:J9 arasına nasıl yapıştırırız

Dosya ektedir

 

[Emir Hüseyin Çoban]

. . .

1 için şu kodları deneyiniz.

 Sub KOD()
 
    Dim rng As Range, cht As ChartObject, say As Double, obj As Object
    yol = CreateObject("WScript.Shell").specialfolders("Desktop") & "\"

    Application.ScreenUpdating = False
 
    Set obj = CreateObject("Scripting.FileSystemObject").GetFolder(yol)
    say = obj.Files.Count + 1

    Set rng = Range(Range("B2:J10").Address)
 
    rng.CopyPicture xlScreen, xlPicture
    Set cht = ActiveSheet.ChartObjects.Add(0, 0, rng.Width + 10, rng.Height + 10)
    cht.Border.LineStyle = 0
    cht.Chart.Paste
    cht.Chart.Export yol & "" & say & ".gif"
    cht.Delete
 
ExitProc:
    Set obj = Nothing: Set rng = Nothing: Set cht = Nothing
    Application.ScreenUpdating = True
 
End Sub

. . .

 

[vivident]

Hüseyin bey denedim

Set cht = ActiveSheet.ChartObjects.Add(0, 0, rng.Width + 10, rng.Height + 10)

+10 yazan kısmıda +1 olarak değiştirdim. Oldu, bu kez adres sormadan direk masaüstüne çıkarttı.

2. soru için bir düşünceniz varmıdır ?

 

[Emir Hüseyin Çoban]

. . .

Yol tanımlamasında masaüstüne çıkarmasını ben tanımladım. Dosya yolu seçmekten daha pratik. +10 lar temsili rakamlar kullanım amacına göre değiştirilebilir.

2 için resim ekle kodları kullanılabilir daha sonra Kill ile masaüstündeki resim silinebilir.

. . .

 

[omemo]

Merhaba,
Açık olan Excel sayfasının yüksek çözünürlüklü resmini almak istiyorum. PrintScreen ve Excel/Ekran Görüntüsü ile aldığım resimlerden daha kaliteli resim almak istiyorum.

Yukarıdaki kodu bu işlem için uyarlayamadım.
Yukarıdaki kod veya başka bir yöntem ile açık olan excel sayfasının kaliteli bir resmini Masaüstüne almada yardımcı olabilir misiniz?
Teşekkürler.