Excel Hücresini Kopyalayıp, Jpg formatında Kaydetme

[LifeCoder]

Xls dosyasındaki belli hücreleri kopyalayıp, jpg formatında, harici bir dosyaya kaydedecek bir makro yazmam gerekiyor. Örnek resim mevcuttur. Yardımlarınızı bekliyorum. Şimdiden teşekkür ederim.

 

[Emir Hüseyin Çoban]

. . .

C sürücü altında Resim adında bir klasör açın.

Kodlar I:J sütununu referans alarak. Resim olarak kaydeder.

Sub KOD()
    
    Dim rng As Range, cht As ChartObject, say As Double, obj As Object
    Const strPath As String = "C:\Resim\"
    
    Application.ScreenUpdating = False
    
    For i = 1 To Cells(Rows.Count, "I").End(3).Row
        
        Set obj = CreateObject("Scripting.FileSystemObject").GetFolder(strPath)
        say = obj.Files.Count + 1
        
        Set rng = Range(Cells(i, "I"), Cells(i, "J"))
        
        rng.CopyPicture xlScreen, xlPicture
        Set cht = ActiveSheet.ChartObjects.Add(0, 0, rng.Width + 0, rng.Height + 0)
        cht.Border.LineStyle = 0
        cht.Chart.Paste
        cht.Chart.Export strPath & "" & say & ".jpg"
        cht.Delete
        
ExitProc:
        
    Next i
    Set obj = Nothing: Set rng = Nothing: Set cht = Nothing
    Application.ScreenUpdating = True
    
End Sub

. . .

 

[LifeCoder]

Deneyeceğim, çok teşekkür ederim.

 

[LifeCoder]

Codeları yazdım ve çalıştı. Lakin bir sorun daha var. Ben belli bir sütündaki resimleri kaydetmek istiyorum ve hücrelerde 2 resim var. Ayrıca her bir hücre 4 range'ten oluşuyor. Bunu nasıl yapabiliriz. Yani jpg olarak resmi kaydetmekten ziyade, hücreyi kopyalayıp jpg olarak kaydetmemiz gerekiyor.

 

[Emir Hüseyin Çoban]

. . .

4 hücre olayı için şu kodları deneyin.

Resim üzerinden hücre değerini anlamak zor. Hücredeki veriler resim mi metin mi ayırt etmek zor.
Örnek olsaydı üzerinde çalışırdık.

Sub KOD()
    
    Dim rng As Range, cht As ChartObject, say As Double, obj As Object
    Const strPath As String = "C:\Resim\"
    
    Application.ScreenUpdating = False
    
    For i = 1 To Cells(Rows.Count, "I").End(3).Row[COLOR="Blue"] Step 2[/COLOR]
        
        Set obj = CreateObject("Scripting.FileSystemObject").GetFolder(strPath)
        say = obj.Files.Count + 1
        
        Set rng = Range(Cells(i, "I"), Cells(i [COLOR="Blue"]+ 1[/COLOR], "J"))
        
        rng.CopyPicture xlScreen, xlPicture
        Set cht = ActiveSheet.ChartObjects.Add(0, 0, rng.Width + 0, rng.Height + 0)
        cht.Border.LineStyle = 0
        cht.Chart.Paste
        cht.Chart.Export strPath & "" & say & ".jpg"
        cht.Delete
        
ExitProc:
        
    Next i
    Set obj = Nothing: Set rng = Nothing: Set cht = Nothing
    Application.ScreenUpdating = True
    
End Sub

. . .

 

[LifeCoder]

[link=http://www.dosyayukleyin.com/do.php?id=4486]exmple.xlsx[/link]

Dosyayı buraya yükledim. Buradan inceleyin isterseniz.

 

[Emir Hüseyin Çoban]

. . .

Şöyle bir çalışma yapsak uygun olur mu.
Seçtiğiniz hücre aralığını (Ör. I12:J19) 4' erli hücrelere göre resim olarak çıkarsa işinizi görür mü.

. . .

 

[LifeCoder]

Nasıl olucak tam anlamadım. Yani mesela jpg resim ile (üretim-işlem sembolü) alttaki numara mesela 8B tek bir resim olarak kaydolucak. Copy + paste --> paint ile manuel olarak yapıyorum ama bunu bir programa çevirmemiz gerekiyor. Bunu o hücrelerin durumunda dolayı nasıl yapabileceğimi çözemedim.

 

[LifeCoder]

4er li hücrelere göre resim olarak çıkmasından kastınız büyük hücreyi kopyala yapıştır yapmak ise tam istediğim o zaten.

 

[halit3]

yukarıdaki linkdeki dosyayı indirin uzantısını .xls olarak değiştirin ve seçilen hücreyi veya nesneyi komut düğmesine basınca masa üstünde Resimler klasörüne kayıt yapıyor

not:
dosyanın adı (resim.avi) bu dosyanın adını (resim.xls) olarak değiştirmelisiniz.

 

[LifeCoder]

Win7 kullanıyorum format değişmiyor. Folder Options dan ayarları da yaptım olmadı nedense.

 

[LifeCoder]

Dosyayı xls formatında atma imkanınız yok mu, kullandığım işletim sistemi sürümünde dosya uzantısı değişmiyor.

 

[LifeCoder]

Programı çalıştırdım halit bey ama istediğim bu tarz bişey değil. k-l sütunundaki bütün resimleri tek defada, tek commandbutton la kaydetme. Ama sorun şu ki alttaki yazıyla birlikte tek parça resim olması gerekiyor.

 

[Emir Hüseyin Çoban]

Nasıl olucak tam anlamadım. Yani mesela jpg resim ile (üretim-işlem sembolü) alttaki numara mesela 8B tek bir resim olarak kaydolucak. Copy + paste --> paint ile manuel olarak yapıyorum ama bunu bir programa çevirmemiz gerekiyor. Bunu o hücrelerin durumunda dolayı nasıl yapabileceğimi çözemedim.

. . .

Aşağıdaki GİF' i izleyiniz. Bu şekilde
Hücre aralığını seçip, buradaki hücreleri resim olarak çıkarabiliriz.

. . .

 

[halit3]

yukarıdaki linkdeki dosyayı indirin uzantısını .xls olarak değiştirin ve seçilen hücreyi veya nesneyi komut düğmesine basınca masa üstünde Resimler klasörüne kayıt yapıyor

not:
dosyanın adı (resim2.avi) bu dosyanın adını (resim2.xls) olarak değiştirmelisiniz

 

[LifeCoder]

görsel video


yukarıdaki linkdeki dosyayı indirin uzantısını .xls olarak değiştirin ve seçilen hücreyi veya nesneyi komut düğmesine basınca masa üstünde Resimler klasörüne kayıt yapıyor

not:
dosyanın adı (resim2.avi) bu dosyanın adını (resim2.xls) olarak değiştirmelisiniz

Windowsun sürümünden kaynaklı bir sorun yaşadım ama değiştirmeyi başardım formatı


Programa dönecek olursak :

Range("I12:J13").Select
    Selection.Copy
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 18
    Range("AH14").Select
    ActiveSheet.Paste
    Sheets("SERİ1").Select

Module den bu codeları elde ettim. Bunlar hücre kopyalama kodları. Bunu jpeg dosya kaydetme codelarıyla birleştirebilirsek sorunu halletmiş oluruz.


Birden fazla hücrede görünme olayına gelince: bu sadece bir göz yanılmasıymış Hücre geniştelince diğer hücrelerin üzerine kayıyor ve bitişik görünüyormuş. İlk defa karşılaştım böyle bi durumla ve range olarak nasıl göstereceğimi bilemedim.

 

[LifeCoder]

Bu program seri üretimde kullanılacak ve müşteriye sunmamız gereken programda, tek bir tuşla tüm işlemlerin halledilmesi gerekiyor. Yani "select" yaptıramayız. Erişebilirliğinin kolay olması gerekiyor.

 

[LifeCoder]

Hüseyin bey çok teşekkür ediyorum yardımlarınız için.

 

[halit3]

Windowsun sürümünden kaynaklı bir sorun yaşadım ama değiştirmeyi başardım formatı


Programa dönecek olursak :

Range("I12:J13").Select
    Selection.Copy
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 18
    Range("AH14").Select
    ActiveSheet.Paste
    Sheets("SERİ1").Select

Module den bu codeları elde ettim. Bunlar hücre kopyalama kodları. Bunu jpeg dosya kaydetme codelarıyla birleştirebilirsek sorunu halletmiş oluruz.


Birden fazla hücrede görünme olayına gelince: bu sadece bir göz yanılmasıymış Hücre geniştelince diğer hücrelerin üzerine kayıyor ve bitişik görünüyormuş. İlk defa karşılaştım böyle bi durumla ve range olarak nasıl göstereceğimi bilemedim.

Ben sizin mesajınızdan bir şey anlamadım.
yukarıdaki linkdeki dosyayı indirdiğinizde gerekli açıklamalarımı yaparak dosyayı açtığınızda (resimlerin hepsini kayıt et) komut düğmesine tıkladığınızda masa üstüne Resimler klasörü içine resimleri kayıt yapıyor bu işlemler işinizi görmüyormu ?

Gelelim yukarıdaki mesajınızdaki kod ("I12:J13") aralığını ("AH14") hücresine yapıştırıyor. Buradan ne elde etmek istediniz.

Profilinizde Excel 07 yazıyor bu ne anlama geliyor excelin böyle bir sürümümü var.

Hücre veya resim kopyalama veya resimleri hücrelere yerleştirme işlemleri veya buna benzer işlemlerin makro kodu ile yaplmasını istiyorsanız hücreleri birleştirme işlemlerinden sakınınız.

iyi çalışmalar.

 

[LifeCoder]

Ben sizin mesajınızdan bir şey anlamadım.
yukarıdaki linkdeki dosyayı indirdiğinizde gerekli açıklamalarımı yaparak dosyayı açtığınızda (resimlerin hepsini kayıt et) komut düğmesine tıkladığınızda masa üstüne Resimler klasörü içine resimleri kayıt yapıyor bu işlemler işinizi görmüyormu ?

Gelelim yukarıdaki mesajınızdaki kod ("I12:J13") aralığını ("AH14") hücresine yapıştırıyor. Buradan ne elde etmek istediniz.

Profilinizde Excel 07 yazıyor bu ne anlama geliyor excelin böyle bir sürümümü var.

Hücre veya resim kopyalama veya resimleri hücrelere yerleştirme işlemleri veya buna benzer işlemlerin makro kodu ile yaplmasını istiyorsanız hücreleri birleştirme işlemlerinden sakınınız.

iyi çalışmalar.

Yukarıda verdiğim örnek kopyalama kodu. Ben bunun algoritmasını yaparak, söz konusu hücrelerdeki resimleri "kopyala, jpeg olarak kaydet" işlemlerini yapmaya çalışıyorum.

Excel 07', office 2007 sürümü oluyor. Tabloları da ben hazırlamadım.