Resim Birleştirme

[yasin85]

Herkese Merhaba,

Satışını yaptığımız ürünlerin resimleri ürün kodlarına göre ON,UST,ALT olarak ayrı ayrı (.JPG) olarak klasörümüzde yer almaktadır. ( Örnek dosyada göre bilirsiniz)

Aynı kodda olup fakat yön durumuna göre sıra ile birleştirip tek bir (.JPG) dosyası yapmak istiyoruz bu konuda bir çözüm bulamadık makro ile bu durumu çöze bilirmiyiz.
1 - 3 lü resmi olanlar
2 - 2 li resim olanlar
3 - 1 li resim olanlar
olarak 3 grup var 3 örneğide ekledim.
klasörümüzde 3700 adet resim var birleştirilmeyi bekleyen desteklerinizi bekliyoruz.

Resimleri İndirme Linki

 

[yasin85]

Tekrar Merhaba,

Konumuz günceldir.
Talebimiz mantık olarak makro ile yapılamayacak bir istek ise lütfen yazarmisiniz beklenti içinde olmayalım..

Teşekkürler..

 

[Zeki Gürsoy]

Elbette makro ile yapılabilir ama... Gdi/GdiPlus API kitaplığı ile yapılabilir. Konu, grafik/resim ve teknik olarak Win32 API işi olduğundan herkesin altından kalkabileceği bir iş değil. Yapılabilirliği mümkündür; destek verebilecek kişi kuvvetle muhtemel bu forumda değil ve bu konuda ücretsiz destek beklentisinde olmayın...

 

[yasin85]

Elbette makro ile yapılabilir ama... Gdi/GdiPlus API kitaplığı ile yapılabilir. Konu, grafik/resim ve teknik olarak Win32 API işi olduğundan herkesin altından kalkabileceği bir iş değil. Yapılabilirliği mümkündür; destek verebilecek kişi kuvvetle muhtemel bu forumda değil ve bu konuda ücretsiz destek beklentisinde olmayın...

@Zeki Gürsoy Bey Merhaba,
Zaman ayırıp bilgi verdiğiniz için teşekkür ederiz.

 

[halit3]

Aşağıdaki linkdeki dosyayı indir ve kontrol et

ornek.rar dosyasını indir - download

ornek.rar dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

uygulama: komut düğmelerine sırası ile basılacak

 

[yasin85]

@halit3 Bey Merhaba,
Öncelikle çok teşekkür ederiz.
Zaman ayırıp bizlere destek olduğunuz için..

Dosyanın orjinal halini direkt denemek istedik alt resimdeki resime isim verme konusunda uyarı verdi bu uyarıyı nasıl aşa biliriz.

1-) İşleme başlamadan resime isim verme konusunda birleştirme kayıt edilirken rastgele bir isim değilde birleştirilmeden önce ki resimin isminde var olan resim isimlerini almamız mümkünmüdür hepsinin ürün kodları resim isimlerinde yazıyor.

- Bunu talep etmemizin sebebi ürünlerin teknik resimlerine göre ayırt etmemiz mümkün olmaz şuan yaklaşık 3700 kalem ürünü birleştireceğimiz için tahmini 1800 kalem ürün oluşacak yapıla bilecek bir işlem var mıdır.

2-) Excel hücrelerini büyütürsek kayıt etmeden önce resim boyutlarıda buna göre büyür mü? Test edemediğim için göremedim.

şuan için fark ettiğimiz detay bu şekilde dir.

Desteklerinizi bekliyoruz.

 

[halit3]

ornek2.rar dosyasını indir - download

ornek2.rar dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

bu dosya resimleri 640*480 ölçeğinde yapıyor
sayfadaki resimler ne kadar büyük olursa kalitede o kadar artacaktır.
her 50 kayıtda 4 saniye baylamaktedir

 

[yasin85]

@halit3 Bey Merhaba,

Dosyayı indirip denedik.
Dosya nın orjinal halini bozmadan.. resimleri birleştir butonuna bastığımızda kayıt işleminde uyarı aldık. resim dosyasını ekledik.
Bu oluşan durumu açmak için yardımcı olurmusunuz.

Desteklerinizi bekliyoruz.

 

[yasin85]

Sn. @halit3 Beyin Destekleri ile Makro ile resim birleştirme makrosu tamamlanmıştır.

Kendilerine çok teşekkür ederiz bizleri çok büyük bir zahmetten ve çok büyük bir zamandan tasarrufu ettirdi.
İnşallah sizlerinde faydalana bileceği bir uygulama olmuş olur.
Dosyanın tüm halini sizlerle paylaşıyoruz.

Makro ile Resim Birleştirme Uygulamasını İNDİR

 

[yasin85]

@halit3 Bey'in,
Revizesi ile Excel versiyonunda yapılan değişiklikle windows8.1 windows 10 da ofis 2003 ve ofis 2007 de çalışyor.
Bilgilerinize.

 

[metin_0606]

Halit beyin çok güzel uygulamalarda imzası vardır. Saygılar

 

[balanar]

Halit beyin çok güzel uygulamalarda imzası vardır. Saygılar

Kesinlikle katılıyorum. Halit bey çok ince dokunuşlar yapıyor. Forumda bu tarz çok saygıdeğer insanlar mevcut. Haluk bey, yusuf bey, ömer bey ve daha niceleri.. ALLAH hepsinden razı olsun

 

[oydemir]

iyi akşamlar aradığım bir program olmuş ellerinize sağlık
yüklediğimde bir türlü çalıştıramadım. Sil butonu çalışıyor
Getir butonuna bastığımda ekteki hata veriyor (hata veriyor_1) resimdeki hatayı alıyorum

Sub resm_bul()
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Hedef sürücüyü seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.self.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo atla
say = 0
Liste1 (Kaynak)
Liste2
Liste3
Liste4
Else
atla:
MsgBox "Lütfen Hedef sürücüyü Seçimini Yapınız !", vbInformation, "DİKKAT"
End If

End Sub

Resimleri getir dediğimde ekteki hatayı veriyor (hata_resim_getir)
Sub resm_bul()
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Hedef sürücüyü seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.self.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo atla
say = 0
Liste1 (Kaynak)
Liste2
Liste3
Liste4
Else
atla:
MsgBox "Lütfen Hedef sürücüyü Seçimini Yapınız !", vbInformation, "DİKKAT"
End If

End Sub

Bu konuda yardımcı oluyorsanız sevinirim.
makro konusunda bilgim yoktur

 

[yasin85]

@halit3 Bey Merhaba,

Nasılsınız umarım iyisinizdir.

Geçen yıl destek verip yardımcı olduğunuz ve ortaya çok güzel bir çalışma çıkarttığınız sizler için küçük fakat bizim için önemli ve zaman konusunda bizleri oldukca tasarruf ettiren resim birleştirme makrosu konusunda sizlerin tekrardan desteğine ihtiyaçımız var.

Resimleri Getir butonuna tıkladığımda " Can't find project and library "hatası veriyordu.
Çözümü : VBA penceresinde. Tools - References menüsünden - [MISSING] ile başlayan kaldırarak denedim.
- ilgili uyarı kayboldu. ve klasör seçme kısmına geçtim.

Önem sırasına göre yazıyorum detayları..

1-) Resimler klasörünü seçtikten sonra ekrana gelmesi gereken resimler gelmiyor. ( Desteğinizi Bekliyoruz )

2-) Pazaryerlerinde satış yaptığımızdan dolayı her satış platformunun farklı resim boyut istekleri oluyor..
Örneğin :
Trendyol : 1200×1800
Hepsiburada : 1500×1500

Bu durumun çözümü için manuel olarak şöyle yapıyoruz.

Paint 'ten ilgili boyutu ayarlıyoruz.
Mevcut ürün resimini bu dosyanın üstüne kopyalıyoruz zeminleri beyaz olduğu için boyut sorununu çözüyoruz.

Resimi büyütmeye çalışır isek resim görüntüsü çok kötü oluyor en pratik çözümümüz bu şekilde bula bildik.

Manuel yaptığımızbu işlemi makro ile çözüm bulmamız mümkünmüdür.

Destekleriniz için şimdiden teşekkür ederim.

 

[halit3]

2. sorunuz için kodun bu bölümlerini değiştirerek istediğiniz sonuca ulaşabilirsiniz.

gen = 1560 ' burası
yük = 730 'burası

1. sorunuz için muhtemelen ofis sürümünüzden kaynaklanıyor olabilir
şuan kullandığınız dosyayı ekleyin bir bakalım. ve kullandığınız ofis sürümünü de yazın

 

[yasin85]

@halit3 Bey Merhaba,

Cevaplarınız için çok teşekkür ederim.

Testlerimi yaptım tekrardan test yaparken fark ettim En son yaptığınız " Resimleri birlestir3.xlsm " dosyası 1 den çoklu resim birleştirme olduğunda çalışıyor hiç bir sorun yoktur.

Eski - Daha önceden yaptığımız çalışmada bu makro 1-2-3 lü olarak ayarlamıştık. " Resimleri birlestir2.xlsm " dosyasında " clipboard.dll " dosyası Reference VBA PROJECT eklentisinde olması gerek internetten dll dosyasını indirdim. ilgili alana eklemek istediğimde eklemeye izin vermiyor.
(Tekli resimlerin boyutunu değiştire bileceğimi düşündüğüm için bu eski dosyayı yazıyorum.)

Aslında " Resimleri birlestir3.xlsm " çalışma sistemine tekli resimlerin boyutunu'da ayarlaya bilmemizi sağlaya bilir isek Tek Makro dosyasıyla çok daha kolay işlemimiz sonuçlana bilir.
Dosyaları ve 1-2-3 resimlerden örnek dosyaladım ve linke ekledim.

Müsait olduğunuz bir zamanda kontrol ede bilirseniz çok seviniriz.

https://s7.dosya.tc/server25/qw4b8c/resim_birlestir_2_3.rar.html

 

[halit3]

Aslında " Resimleri birlestir3.xlsm " çalışma sistemine tekli resimlerin boyutunu'da ayarlaya bilmemizi sağlaya bilir isek Tek Makro dosyasıyla çok daha kolay işlemimiz sonuçlana bilir.

tekli dosya boyutunu anlıyamadım sayfadaki hücrelere mi yerleşmiyor resimler.

Modüle3 deki kodu sil bunu ekle
resimlerin boyutunu kırmızı yerler ayarlıyor bunları kendinize göre değiştirebilirsiniz.

Sub resimolustur()

Dim fL As Object, Kayıt_Yeri As Variant, Dosya_Adı As String
Dim say As Long
Dim s1
Set s1 = Sheets(ActiveSheet.Name)
'On Error Resume Next

Set fL = CreateObject("Scripting.FileSystemObject")
Kayıt_Yeri = ThisWorkbook.Path & "\Resimler\"

If Not fL.FolderExists(Kayıt_Yeri) Then
fL.CreateFolder (Kayıt_Yeri)
End If

For r = 1 To s1.Cells(Rows.Count, "A").End(3).Row
say = fL.GetFolder(Kayıt_Yeri).Files.Count + 1

Resim = Cells(r, 6)

Dosya_Adı = Kayıt_Yeri & Resim & "_" & Format(say, "0000") & ".jpg"

sat = 1
Dim Picture As Object
For Each Picture In s1.Shapes
If Picture.Type = 11 Or Picture.Type = 13 Then
If r = Picture.TopLeftCell.Row Then
sat = sat + 1
End If
End If
Next

s1.Range(s1.Cells(r, 2), s1.Cells(r, sat)).Copy

dosyaadi2 = Kayıt_Yeri & "resimmmmmm.jpg"
s1.Image1.Picture = LoadPicture(None)

s1.Image1.Picture = PastePicture
SavePicture s1.Image1.Picture, dosyaadi2


Dim Img As Object, IP As Object
Set IP = CreateObject("WIA.ImageProcess")
Set Img = CreateObject("WIA.ImageFile")
Img.LoadFile dosyaadi2

gen = 1560 
yük = 730

IP.Filters.Add IP.FilterInfos("Scale").FilterID
IP.Filters(1).Properties("MaximumWidth") = gen
IP.Filters(1).Properties("MaximumHeight") = yük
IP.Filters(1).Properties("PreserveAspectRatio") = KeepAspect

Set Img = IP.Apply(Img)
Img.SaveFile Dosya_Adı


sat2 = sat2 + 1
If sat1 = 50 Then
Application.Wait (Now + TimeValue("0:00:03"))
'MsgBox "devam et"
CreateObject("WScript.Shell").Popup "işlem devam ediyor", 1, " UYARI!", vbOKOnly + vbInformation
sat2 = 0
End If

'On Error Resume Next
If Not IP Is Nothing Then Set IP = Nothing
If Not Img Is Nothing Then Set Img = Nothing

Kill dosyaadi2
atla:
Next r

s1.Image1.Picture = LoadPicture(None)
MsgBox Kayıt_Yeri & "  klasörüne resim ekleme işi yapıldı"

End Sub

 

[yasin85]

@halit3 Merhaba,

Doğrudur.
Dosya yolunu gösterip tamam dediğimde Tek'li resimler sadece hücrelere hiç gelmiyor.
Çoklu resimler sorun yok çalışıyor..

tekli dosya boyutunu anlıyamadım sayfadaki hücrelere mi yerleşmiyor resimler.

 

[halit3]

Resim dosyaları

Liste2,Liste3,Liste4 kodlarında resim dosya adı aranan kelimeler "ON", "UST", "ALT" bunlar eğer dosya isimlerinde bu sözcükler yoksa resim ekleme işi yapılamaz.

 

[yasin85]

@halit3 Merhaba,

Resim isimlerine ek olarak "ON" harflerini ekledim.
Sorunsuz olarak çalıştı.

Değerli destekleriniz için çok teşekkür ederim.
Allah razı olsun..