Exceldeki resimleri dışarı çıkartma

[omerap06]

Merhaba I sutununda her hücrede resimler var ve sırasıyla resim1 resim2 ... şeklinde adlandırarak C:\Users\Pc\Desktop\Yeni Klasörünün içine indirmesini istiyorum sabahtan beri uğraşıyorum yapamadım acil bir şekilde yardım edebilcek üstadım var mı teşekkürler(Birde jpg formatında olursa mükkemmel olur)

 

[Korhan Ayhan]

Merhaba,

Linkleri inceleyiniz..

kapalı excel dosyalarından resimleri çıkartmak

merhaba ustadlarım. elimde tek klasör ıcınde 2000 adet excel dosyası var ve bu dosyların içlerinde jpg formatında resımler var. ben bu excellerın ıcındekı resımlerı baska bır klsöre toplamak ıstıyorum ( resım kalıtelerı bozulmadan ). resımlerı toplarken hangı excelden aldıysa o excelın...

www.excel.web.tr

Excel'deki resimleri isimlendirerek dışarıya çıkartma

Arkadaşlar merhaba, bir kamu kurumunda görev yapıyorum. Bizim yıllardır excelde tutmuş olduğumuz personele ilişkin bir excel tablosu var. Birinci sütunda her hücrede kişinin fotoğrafı, yandaki ikinci sütunda ise her hücrede ilgilinin TC kimlik numarası var. Yeni bir sisteme geçeceğiz ve bizden...

www.excel.web.tr

 

[omerap06]

Sub Test()
' Haluk - 29/03/2021
Dim objTemp As Object
Dim chtMyChart As Chart

For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
Range("A" & i).Copy
Set objTemp = ActiveSheet.Shapes.AddShape(1, 1, 1, 1, 1)
objTemp.Select
ActiveSheet.Paste
objTemp.Delete

With Selection
.CopyPicture 1, 2
Set chtMyChart = ActiveSheet.ChartObjects.Add(1, 1, .Width, .Height).Chart
With chtMyChart
.ChartArea.Border.LineStyle = xlNone
.Paste
.Export "C:\TestFolder\" & Range("B" & i).Text & ".jpg"
.Parent.Delete
End With
.Delete
End With
Next

MsgBox "Resimler aktarıldı..."
Set objTemp = Nothing
End Sub
Üstadım çok baktım bunlara ama olmuyor 2. attığınız konuda bu kod tam işime yarayacak bi kod ama .CopyPicture 1, 2 burda hata veriyor çözemedim bir yardımcı olurmusunuz

 

[Korhan Ayhan]

Bu kodun çalışması için resimlerin A sütununda olması gerekiyor.. Bunu kontrol ediniz..

 

[dEdE]

Alternatif

Sub Resim_Aktar()
On Error Resume Next
Say = 1
Yol = "C:\Users\Pc\Desktop\Yeni\"
For Each Resim In ActiveSheet.Shapes
    If Resim.TopLeftCell.Column = 9 Then
    Resim_Adi = "Resim " & Say
        Resim.Copy
        Set Resim_Gecici = ActiveSheet.ChartObjects.Add(0, 0, Resim.Width, Resim.Height)
        With Resim_Gecici
            .Border.LineStyle = xlLineStyleNone
            .Activate
            ActiveChart.Paste
            .Chart.Export Yol & Resim_Adi & ".jpg"
            .Delete
        End With
    End If
    Say = Say + 1
Next
End Sub

 

[omerap06]

Alternatif

Sub Resim_Aktar()
On Error Resume Next
Say = 1
Yol = "C:\Users\Pc\Desktop\Yeni\"
For Each Resim In ActiveSheet.Shapes
    If Resim.TopLeftCell.Column = 9 Then
    Resim_Adi = "Resim " & Say
        Resim.Copy
        Set Resim_Gecici = ActiveSheet.ChartObjects.Add(0, 0, Resim.Width, Resim.Height)
        With Resim_Gecici
            .Border.LineStyle = xlLineStyleNone
            .Activate
            ActiveChart.Paste
            .Chart.Export Yol & Resim_Adi & ".jpg"
            .Delete
        End With
    End If
    Say = Say + 1
Next
End Sub

üstadım kod çalıştı eline sağlık ama 5.fotoğraftan sonrasında sadece beyaz bir kare çıkıyor birde pikselleri aşırı kötü oldu zor gözüküyor resim

 

[Zeki Gürsoy]

Resimlerinizi tek satır kod yazmadan WinRAR ile de alabilirsiniz. Dosyanızı Windows "Birlikte Aç" seçeneğini kullanarak "WinRAR" ile açın. Aşağıdaki görselde de göreceğiniz üzere orjinal resimleriniz xl\media dizinindedir.

 

[omerap06]

Resimlerinizi tek satır kod yazmadan WinRAR ile de alabilirsiniz. Dosyanızı Windows "Birlikte Aç" seçeneğini kullanarak "WinRAR" ile açın. Aşağıdaki görselde de göreceğiniz üzere orjinal resimleriniz xl\media dizinindedir.

Ekli dosyayı görüntüle 251141

Üstadım sırayla indirmiyor karışık bi sıra ile indiriyor benim dikkatimi çeken şu oldu excelde ilk resime tıklıyorum sonra tab ile diğer resime geçiyorum ordada tab ile geçerken sırayla geçmiyor karışık geçiyor ve şurası tuhaf tab ile geçtiği resimlerin sırası sizin attığınız resimlerin sırası ile aynı gidiyor yani şöyle örneğini veriyim excelin içinde ilk satırdaki resim resim1 sonra tab a tıklıyorum excelin ortasından bir resime gidiyor ve sizin attığınız resimdeki sırayla gidiyor o resimde yazan image2 benim tab a bastığımdaki resim

 

[Zeki Gürsoy]

@omerap06, önceki mesajınızda resim kalitesinin kötü olduğunu, beyaz fon olarak göründüğünü belirttiğiniz için WinRar yöntemini önermiştim. Oradan orjinal resimleri alabilmeniz mümkündü....

Dosyanızda hepitopu 35 adet resim var; isimlendirmeleri elle yapabileceğinizi düşünmüştüm. Kendi bilgisayarınızda yüzlerce, binlerce resim içerebilen dosyalarınız varsa, dosya içeriklerini okuyabilen özel bir dll yazabilirim.

.

 

[omerap06]

hocam 500 e yakın resim var o örnek dosya yarın düzenleyip atayım size

 

[Zeki Gürsoy]

Dosya büyük olabilir. Varsa, 7-zip ile, yoksa WinRar ile iyice sıkıştırın. Ayrıca, xml yapısındaki ResId ile Image arasındaki ilişkiyi çözebilmem için bana biraz zaman verin.

.