Excel Tablosunu Jpeg olarak kaydetmek

[Beytur35]

Arkadaşlar...

Uzun bir excel tablosunu (uzun derken bir ekran görüntüsünden daha fazla) jpeg formatlı olarak nasıl kaydedebiliriz? Bazı programlar var ama ancak bir ekran görüntüsü kadar olan kısmını jpeg olarak çeviriyor. Bunu istememin amacı bir excel tablosunu bazı programlar yardımı ile foruma eklemek için sadece jpeg formatını desteklemesi. Ya da ikinci şık olarak bir excel tablosunu copy/paste dışında (çünkü düzgün olmuyor) forumda mesaj yazdığım yere nasıl ekleyebilirim.Ancak dediğim gibi bir ekran görüntüsünden fazla bir çalışma olacak. Cevap için şimdiden teşekkürler.

 

[Seyit Tiken]

Şöyle bir şey yapabilirsiniz, 1. Yöntem : İlgili alanı kopyalayıp Paint'e yapıştırın, 2. Yöntem : İlgili alanı, Shift tuşuna basılı tutarak > Düzen > Resmi Kopyala > Paint'e Yapıştır'ı deneyerek sonucu değerlendiriniz.

Not : JPEG resimlerinizi bu siteye yükledikten sonra ilgili siteye yükleyebilirsiniz.
http://imgur.com/

 

[muygun]

Merhaba;
Alternatif olsun.
Eki deneyin.
İyi çalışmalar.

Not: Kodlar alıntıdır.

 

[nokmen]

Merhaba;
Alternatif olsun.
Eki deneyin.
İyi çalışmalar.

Not: Kodlar alıntıdır.

Ben de buna benzer bir kod arıyorum sadece alanı yazmak yerine seçilmiş alana uygulamak şeklinde. Bunu da denemek istedim ama sonuç alamadım. Yani klasöre hiç dosya eklenmiyor.

Bana verdiğiniz kod çalışıyordu ama resim biraz bulanık ve içine başka dosya görüntüleri karışıyordu. Ona tekrar bakabilir misiniz?

 

[Beytur35]

Sayın Seyit Tiken ve Sayın muygun

Sizlere vermiş olduğunuz cevaplardan dolayı ayrı ayrı teşekkür ediyor, sağlıklı ve mutlu günler diliyorum.

 

[muygun]

Ben de buna benzer bir kod arıyorum sadece alanı yazmak yerine seçilmiş alana uygulamak şeklinde. Bunu da denemek istedim ama sonuç alamadım. Yani klasöre hiç dosya eklenmiyor.

Bana verdiğiniz kod çalışıyordu ama resim biraz bulanık ve içine başka dosya görüntüleri karışıyordu. Ona tekrar bakabilir misiniz?

Merhaba;
Ofis 2003 te sorunsuz sonuç aldığım bir kod. (Ofis 2003 kurulu bir bilgisayarda test edin.)
İyi çalışmalar.

 

[saviola26]

Merhaba;
Alternatif olsun.
Eki deneyin.
İyi çalışmalar.

Not: Kodlar alıntıdır.

Merhaba.
Öncelikle emeğiniz için teşekkürler.
Verdiğiniz dosya ve Chart.Paste türevleri Excel2016'da sonuç vermiyor. Yani jpg dosyası oluşuyor ama içi boş.

Ne yapılabilir? Eskiye mi dönmeli bunun için? Mesela Excel2010'da denedim, sonuç verdi.

 

[levo26]

Merhaba alternatif olsun. Aşağıdaki kodları denermisiniz.

Option Explicit

Private Sub SaveRngAsJPG(Rng As Range, FileName As String)
Dim Cht As Chart, bScreen As Boolean, Shp As Shape
bScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
Set Cht = Workbooks.Add(xlChart).Charts(1)
Cht.ChartArea.Clear
Rng.CopyPicture xlScreen, xlPicture
Cht.Paste
With Cht.Shapes(1)
.Left = 0
.Top = 0
.Width = Cht.ChartArea.Width
.Height = Cht.ChartArea.Height
End With
Cht.Export FileName, "JPEG", False
Cht.Parent.Close False
Application.ScreenUpdating = bScreen
End Sub

Sub TestIt2()
Dim Rng As Range, Fn As String
Set Rng = Range("A1:H20")
Fn = "C:\ExcelSayfam.jpg"
SaveRngAsJPG Rng, Fn
End Sub

 

[saviola26]

Merhaba alternatif olsun. Aşağıdaki kodları denermisiniz.

Option Explicit

Private Sub SaveRngAsJPG(Rng As Range, FileName As String)
Dim Cht As Chart, bScreen As Boolean, Shp As Shape
bScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
Set Cht = Workbooks.Add(xlChart).Charts(1)
Cht.ChartArea.Clear
Rng.CopyPicture xlScreen, xlPicture
Cht.Paste
With Cht.Shapes(1)
.Left = 0
.Top = 0
.Width = Cht.ChartArea.Width
.Height = Cht.ChartArea.Height
End With
Cht.Export FileName, "JPEG", False
Cht.Parent.Close False
Application.ScreenUpdating = bScreen
End Sub

Sub TestIt2()
Dim Rng As Range, Fn As String
Set Rng = Range("A1:H20")
Fn = "C:\ExcelSayfam.jpg"
SaveRngAsJPG Rng, Fn
End Sub

İlginiz için teşekkür ederim.
İlk defa excel2016'da bir görüntü kaydedebildim sayenizde
Tabi bazı sorunlar var onları aktarayım; umarım çözüme kavuşturursunuz beni.
1-Makroyu direk çalıştırınca
With Cht.Shapes (1)

kısmında bir hata verdi. sonra ben onu Shapes(1) haline getirdim, çalıştı. belki de aynı şeydir, bilmiyorum. Olur da bu kodu da indiren arkadaşlar olur diye anlattım.

2-Yukarıdaki hatadan sonra da şöyle bir hata verdi.

Runtime error ........: Belirlenen koleksiyona olan dizin sınırlar dışında.

Sonra F8 tuşuna basarak adım adım gideyim dedim. Excel'e bir grafik çizdiriyoruz ya, yeni bir sayfa açılıyor. Biliyorsunuz o ekran kendiliğinden açılıyor. Ben o ekranı kapatmadım, yine bizim makro penceresine tıklayıp aktif hale getirdim ve F8'e basmaya devam ettim, adım adım gitti ve sonunda end sub'dan çıktık. D: sürücüsünü hedef göstermiştim, dosyamın oluştuğunu gördüm. Hatta Range aralığını değişerek kendi çalışmama uyarladım. O zaman da şu sorun oldu:

Anladığım kadarıyla biz resme belli bir boyut veriyoruz ve o boyuta sığdır diyoruz. Yani kendi özgün ölçüsünde olmuyor. Sizin ilk verdiğiniz hücre aralığında iken özgün hücre boyutları belirlenen boyuttan küçük olacak ki, resimler büyütülmüş duruyordu. Sonra ben bi de bunu kendi örneğime uyarlayınca -ki örneğimdeki hücre bayağı geniş- bu defa da resim çok kalitesiz ve yazılar okunaksız oldu.

Sorunlar bunlar. Aşabilirsek çok memnun olurum. Yoksa eski versiyona dönüş yapacağım mecburen.

 

[halit3]

Alternatif kod seçili alanı dosyanın yanına kayıt yapıyor.

Kodun çalışması için
clipboard.dll
dosyasını registir etmeniz gerekiyor (regsvr32.exe)

Sub resmikayıtyap()
Dim myClp As Object
Set myClp = CreateObject("clipbrd.clipboard")
myClp.Clear
Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
Klasor = ThisWorkbook.Path
sat = CreateObject("Scripting.FileSystemObject").GetFolder(Klasor).Files.Count
dosyaadi = Klasor & "\" & "Resim" & sat & ".jpg"
'myClp.GetData (Cells(3, 2).Value)
SavePicture myClp.GetData, dosyaadi
MsgBox "İŞLEM TAMAM"""
End Sub

 

[saviola26]

Alternatif kod seçili alanı dosyanın yanına kayıt yapıyor.

Kodun çalışması için
clipboard.dll
dosyasını registir etmeniz gerekiyor (regsvr32.exe)

Sub resmikayıtyap()
Dim myClp As Object
Set myClp = CreateObject("clipbrd.clipboard")
myClp.Clear
Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
Klasor = ThisWorkbook.Path
sat = CreateObject("Scripting.FileSystemObject").GetFolder(Klasor).Files.Count
dosyaadi = Klasor & "\" & "Resim" & sat & ".jpg"
'myClp.GetData (Cells(3, 2).Value)
SavePicture myClp.GetData, dosyaadi
MsgBox "İŞLEM TAMAM"""
End Sub

Merhabalar Halit Bey.
Az evvel evdeki bilgisayarıma Excel2013 kurdum ve bu konudaki ismini tam hatırlayamadığım "Beytur...jpg kaydet" isimli dosya sorunsuz bir şekilde çalıştı. Kafama takılan hep şu oldu. Office 2016 en son sürüm, eskilerde varolan bir özellik son verisyonda neden çalışmasın olmuştu.

Sizin verdiğiniz kodları yarın işyerimdeki excel 2016 da deneyeceğim.
Ayrıca clipboard.dll dosyası normalde windows veya office üzerinde bulunmayan bir dosya mı?
Onu da yüklemeyi öğrenirim. Yarın sonuçlarla size döneceğim.
İlginiz için teşekkür ederim.

 

[saviola26]

Halit Bey az evvel sizin verdiğiniz clipboard.dll dosyasını regsvr32 /n clipboard.dll komutuyla yüklemeyi başardım ve verdiğiniz kod üzerinden makro oluşturdum. çalıştırdığımda şu hatayı verdi:

AcitveX component can't create object

Debug ettiğimde şu satırda hata vermişti:

Set myClp = CreateObject("clipbrd.clipboard")

 

[halit3]

Halit Bey az evvel sizin verdiğiniz clipboard.dll dosyasını regsvr32 /n clipboard.dll komutuyla yüklemeyi başardım ve verdiğiniz kod üzerinden makro oluşturdum. çalıştırdığımda şu hatayı verdi:

AcitveX component can't create object

Debug ettiğimde şu satırda hata vermişti:

Set myClp = CreateObject("clipbrd.clipboard")

Ben kendim manuel yükleme yerine exe dosyası yaptım buraya görsel video ve rar dosyasını ekliyorum rar dosyasını çıkart (dill dosyasını yükle.exe) dosyasını yönetici olarak aç ve clipboard.dll dosyasını seçerek işaretle (seçilenlerin hepsini aktar) düğmesine tıkla
ayrıca aşağıdaki linki irdele
http://www.excel.web.tr/f50/dll-dosyalaryny-yukleme-t115924.html

görsel video

 

[anemis]

kodlar ve alternatifler için teşekkür ederim. Çok faydalı oluyor benim için de.

 

[saviola26]

Sn. halit3
çook çok teşekkür ediyorum. Office2013 dediğiniz gibi yükledim clipboard'u, kodlar çalıştı.
Zahmet edip video yapmış ve yüklemişsiniz.
Office 2016'da tam olarak deneyemedim bugün. Çok kısa kalabildim PC başında fakat yarın ilk işim bu olacak.
Çok sağolun.
Ayrıca gördüğüm şey şu; resim kalitesi iyiydi.

 

[CelikBey]

Merhaba Sn. halit3.

saviola26 nickli hesaptan yazan bendim. Bu hesabımdan devam edeceğim müsadenizle.

Size dediğim gibi Office2013 yüklü bilgisayarda sizin yazdığınız program hatasız çalışıyor. Çok da net görüntü veriyor. Çok teşekkür ederim.

Fakat office2016 da malesef yine ActiveX hatası alıyorum. Sizin dll yükleme metodunuz da dahil olmak üzere birçok farklı şekilde clipboard.dll dosyasını yükledim, denedim yine aynı hatayı verdi.

Office2016, önceki versiyonları gibi çalışmıyor. Mesela sitedeki diğer kullanıcıların önerilerini makroyu direk çalıştırarak yapamıyorum. F8 tuşuna basarak adım adım ilerlediğimde ancak sonuç alabiliyorum. Çözümü var mıdır bu işin?

 

[halit3]

64 bit sorunu olabilir
aşağıdaki linkten güncel olanı indir birde öyle dene

http://www.dlldownloader.com/tr/clipboard-dll/

 

[levo26]

Teşekkürler halit3 hocam. Yeni gördüm.

 

[CelikBey]

64 bit sorunu olabilir
aşağıdaki linkten güncel olanı indir birde öyle dene

http://www.dlldownloader.com/tr/clipboard-dll/

Sn. halit3

belirttiğiniz dll dosyasını indirdim, yüklemeye çalıştım şu hatayı verdi:

İkili dosyanın belirtilen yolda depolandığından emin olun veya ikili dosyada ya da buna bağımlı .DLL dosyalarında sorun olup olmadığını denetlemek üzere hata ayıklayın.

Belirtilen modül bulunamadı.

Sonrasında eski yüklediğim clipboard dosyalarını sistem klasörlerine geri koydum, unregister yaptım, sildim. Tekrar 64bitlik dll dosyalarını kopyaladım klasöre, yine register yapmaya çalıştım, olmadı verdiğiniz adresteki CMD üzerinden adım adım anlatılanları yaptım yine kabul etmedi.

Velhâsıl-ı kelâm olmadı


Diğer kullanıcıların verdiği yöntemlere gelecek olursak; makrolardaki işlemleri F8 ile adım adım yapınca olmasını, tıklayınca direk olmamasını neye bağlayabiliriz ve çözümü var mıdır? Bilen varsa sevinirim.

 

[CelikBey]

Umarım mesajlarımla burayı boğmuş olmam ama edindiğim gözlemleri diğer kullanıcılarla paylaşma adına yazıyorum:

F8 ile adım adım giderken şöyle bir sorunum vardı Excel2016'da; hem adım adım gideceğiz hem de o anlık tüm sayfa görünüyor olmalıydı. Tüm sayfanın görünme zorunluluğunu da şuna bağladım -yanlışsam düzeltin- kaydetmek istediğim alan sayfanın en altında sağda N137:BE201 aralıkları, ekran görüntüsünü chart ile kaydederken A1 hücresine yapıştırıyor. Fakat ben bu işlemi yapmak istediğim sırada bahsettiğim N137:BE201 hücreleri ekranda görünüyor, haliyle yukarıya gitmek istiyor, sonra da hata veriyor. Ekranı iyice küçültüp ayn işlemi yaptığımda hata vermiyor. Şöyle bir yol izledim. Kodlar aşağıdadır:

________________________________

Sub foto()
Dim obce As Object
Dim caart As Chart
Dim jipeg As Range
Sheets("HESAPLAR").Select
Set jipeg = ActiveSheet.Range("N137:BE201")
jipeg.Copy
Set obce = ActiveSheet.Shapes.AddShape(1, 1, 1, 1, 1)
obce.Select
ActiveSheet.Paste
obce.Delete
With Selection
.CopyPicture 1, 2
Set caart = ActiveSheet.ChartObjects.Add(1, 1, .Width, .Height).Chart
Range("a1").Select
With caart
.Paste
.Export "d:\test.jpg" 'nereye çıkartılacaksa
.Parent.Delete
End With
.Delete
End With
Set jipeg = Nothing
Set obce = Nothing
End Sub

_________________

orijinal halinde

Range("a1").Select

yoktu, ben ekledim. A1 hücresini seçtirerek yardımcı oldum excel'e ve gerçekten ekranı küçültme sorunum çözüldü ama şu F8'e bir çare bulamadım.

Onda da şöyle birşey farkettim. F8 tuşunu adım adım bas bırak yaparak gittiğimde hiçbir sorun olmadığını gördüm. Sonra da elimi basılı tutup denemek istedim. Ekranda hızlı hızlı işlemler geçti ve klasöre baktığımda gene dosyanın var olduğunu ama içinin boş olduğunu gördüm. İlginç birşey.
Kimyasal tepkimelerdeki katalizör gibi excel'in macro hızını düşürecek birşey bulursam sorun çözülecek gibi )