Seçili Hücre Aralığını Resim "*.jpeg" olarak kaydetme

[cellswhite]

İyi çalışmalar.

100 e yakın sheetım var.Tum sayfaların Range("b2:b5") alanı jpeg formatında "C:\out" klasorune sheet isimleri adı altında kaydetmesini istiyorum.

Bu konuda destek verebilirmisiniz.

 

[hamitcan]

Kodlar Alıntıdır.
http://www.codeforexcelandoutlook.com/blog/2008/11/export-excel-range-to-a-picture-file/

Sub CopyRangeToGIF()
    Dim rng As Excel.Range
    Dim cht As Excel.ChartObject
    Const strPath As String = "C:\out\"
    Application.ScreenUpdating = False
    For i = 1 To 3'Sayfa sayısını buradan attırabilirsiniz.
        Set rng = Sheets(i).Range("b2:b5")
        rng.CopyPicture xlScreen, xlPicture
        Set cht = Sheets(i).ChartObjects.Add(0, 0, rng.Width + 10, rng.Height + 10)
        cht.Chart.Paste
        cht.Chart.Export strPath & "myfile" & i & ".jpg"
        cht.Delete
ExitProc:
        Application.ScreenUpdating = True
        Set cht = Nothing
        Set rng = Nothing
        Next
End Sub

 

[cellswhite]

Teşekkurler Hamit Bey,

 

[baydeniro]

Teşekkurler sayın hamitcan.