Excel'de, dosyadaki fotoğraf ile çekilen fotoğrafı eşleştirmek mümkün mü?

achil19 · 23 Kasım 2015

Herkese selamlar,
Öncelikle olacağını pek düşünmüyorum ama yine de sormak istedim. Olmaz diye düşündüğüm birçok şeyi forum sayesinde, makrolar ile yapabildim 
Tekstil üretimi yapan bir şirkette planlama müh olarak çalışıyorum. Eski sezona ait fotoğrafların saklandığı bir klasörümüz var. Yaklaşık 1000 adet fotoğraf mevcut ve her sezon artıyor. Fotoğrafın dosya adı, ürünün kodu olarak tanımlı.
Bazen yönetimden eski sezonlara ait bir fotoğraf geliyor. Ürün ile ilgili rapor isteniyor. Fakat ürünün kodu vs yazmıyor.
Ürün kodunu bulabilmek için önce fotoğraflara bakıp, ürüne ait fotoğrafı bulmam gerekiyor.
Bunu makro ile yapabilir miyim? Yani makroda elimdeki fotoğraf ile seçtiğim dosyada tanımlı bir fotoğrafı eşleştirebilir miyim?
Önceden yazdığım gibi, olabileceğini pek düşünmüyorum ama yine de sormak istedim.
Şimdiden herkese teşekkür ederim.

excelokyanus500 · 23 Kasım 2015

Sorunuzun tam cevabı olmasada benim kullandığım resimleri arama programı işinize yarayabilir.

Verdiğim kodları txt dosyaya yapıştırdıktan sonra txt uzantısını vbs yapıp kaydedin,adresi yazmanız gereken yeri düzenleyin ve deneyin.

'******************************Description du Code img2html.vbs**********************************
'© Hacko
'C'est un VBScript pour rechercher les images avec les extensions "jpg,jpeg,gif,png,bmp,psd,png,tif"
'dans le dossier et sous-dossiers et le résultat sera afficher dans un Tableau en html
'Pour tester ce code chez-vous Copier ce script sous le nom par exemple img2html.vbs
'dans votre dossier images ou bien dans mes documents et exécutez-le !
'************************************************************************************************
start_folder = "C:\Users\xxxxxxxxxxxxx\Pictures\" 'Ana folder adresinigösterin
htmfile = "Liste_Images.htm"
ext = Array("jpg","jpeg","gif","bmp","psd","tif","png") 'extensions des Images à rechercher
count=0
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(start_folder)
Set ws = CreateObject("WScript.Shell")
Set outfile = fso.CreateTextFile((htmfile),1,True)

strHTML="<html><body text=white><style type='text/css'>"&_
"a:link {color: #F19105;}"&_
"a:visited {color: #F19105;}"&_
"a:active {color: #F19105;}"&_
"a:hover {color: #FF9900;background-color: rgb(255, 255, 255);}"&_
"</style>"

strHTML=strHTML &"<center><h2><B><font color=red>Le Nombre Total des images est de [COUNT] <br>©<br><img src=http://photomaniak.com/upload/out.php/i1102064_IDNlogo.gif height=50></font></B></h2></center>" & _
"<table border='1' bgcolor=#1234568 style='border-collapse: collapse; font size:9pt' bordercolor='#CCCCCC' width='100%' id='Table1'>" & _
"<tr><td><center><strong>Image</strong></center></td><td><center><strong>Chemin</strong></center></td>" & _
"<td><center><strong>Taille<strong></center></td><td><center><strong>Type</strong></center></td>" & _
"<td><center><strong>Modifié le</strong></center></td><td><center><strong>Dernier Accès</strong></center></td></tr>"
ListDirectory folder, ext
strHTML = strHTML & "</table>"
strHTML = Replace(strHTML, "[COUNT]", Count)
outfile.WriteLine strHTML &"</body></html>"
outfile.Close

Explorer htmfile

Sub ListDirectory(folder, ext)

For Each objFile In folder.Files
On error resume next
cheminFic = folder & "\" & objFile.name
For i = lbound(ext) to ubound(ext)
If UCase(ext(i)) = UCase(fso.GetExtensionName(objFile.Name)) Then
count=count+1
strFileName = objFile.Name
strFilePath = objFile.ParentFolder
strFileSize = FormatNumber((objFile.Size/1024),2) + " Kb"
strFileType = objFile.Type
strFileModified = objFile.DateLastModified
strFileAccess = objFile.DateLastAccessed

strHTML = strHTML & "<tr><td><center><a target=_Blank href='"& cheminFic &"'><img src='"& cheminFic &"' height=150 width=200></center></td><td><center><a href='" & strFilePath & "'>" & _
strFilePath & "</a></center></td><td><center>" & strFileSize & "</center></td>" & _
"<td><center>" & strFileType & "</center></td><td><center>" & strFileModified & "</center></td>" & _
"<td><center>" & strFileAccess & "</center></td></tr>"

End If
Next
Next
For Each fldr In folder.subfolders
ListDirectory fldr, ext
Next
End Sub

Function Explorer(File)
Set ws=CreateObject("wscript.shell")
ws.run "explorer " & File & "\"
end Function

PLİNT · 23 Kasım 2015

Merhaba
Alternatif olarak aşağıdaki gibi deneyebilirsiniz.
Ek dosyadaki gibi adı değişmiş resmi (veya resimleri) "RESİM KLASÖRÜ" içine excel dosyasının yanına alıp; kodlarda bulunan dosya yolunu ayarlayıp deneyin.
Resim dosyalarını boyut ve oluşturulma tarihine göre karşılaştırıp; şartları uyan eski isimlerini listeleyecektir.
http://s3.dosya.tc/server6/2sev42/RESIM_ARA.zip.html

Kod:

 Private Sub CommandButton1_Click()
Dim ds, f, s, dc, dc2, f2
Dim ARANAN, BUL
Dim a As Integer
[a2:g10000] = Empty
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder(ThisWorkbook.Path & "\")
Set dc = f.Files
Set f2 = ds.GetFolder("[COLOR="Red"]C:\RESİMLER\[/COLOR]")
Set dc2 = f2.Files
For Each ARANAN In dc
If ARANAN.Name <> ThisWorkbook.Name Then
boyut = ARANAN.Size
oluşturulma = ARANAN.DateLastModified
For Each BUL In dc2
If boyut = BUL.Size And oluşturulma = BUL.DateLastModified Then
a = a + 1
Cells(a + 1, 1) = Split(ARANAN.Name, ".")
Cells(a + 1, 2) = ARANAN.Size
Cells(a + 1, 3) = ARANAN.DateLastModified
Cells(a + 1, 5) = Split(BUL.Name, ".")
Cells(a + 1, 6) = BUL.Size
Cells(a + 1, 7) = BUL.DateLastModified
 End If
Next: End If: Next
End Sub

achil19 · 24 Kasım 2015

@excelokyanus500 ve @PLİNT cevaplarınız için çok teşekkürler.
ben tam anlatamadım sanırım. benim istediğim, google görsel arama hesabı.
fotoğrafı google'dan yükleyince benzer fotoğrafları getiriyor.
aynı şekilde yapılabilmesi mümkün mü?
ama pek mümkün gibi gelmiyor bana.

tahsinanarat · 25 Kasım 2015

Sn. PLİNT Muhteşem kodlar paylaşmışsınız. Elinize sağlık. Bende bu kodlardan faydalanarak yanlarına resimlerin getirilmesini sağlayıp eklemeyi planlıyorum.

Sn. achil19 fotoğrafı Google'dan yükleyince benzer fotoğrafların nasıl getirdiğini ben bilmiyorum, yani bir fotoğraf yüklediğimizde benzer fotoğraflar mı geliyor, bu özelliği bize de öğretebilir misiniz.

achil19 · 25 Kasım 2015

selamlar tahsinanarat, evet google da böyle bir uygulama var. özellikle tatil yerlerini bulmada çok yardımcı oluyor

google a, google görsellerde ara yazın. ya da https://www.google.com/imghp?hl=tr linkine tıklayın. açılan sayfada arama çubuğunun yanındaki fotoğraf makinesi simgesine tıklayın, sonrasında görsel yükleyin tıklayın.
bu şekilde aramak istediğiniz fotoğrafı yükleyebiliyorsunuz.

tahsinanarat · 25 Kasım 2015

Sn. achil19 ilgin için çok teşekkürler, gerçekten ben fotoğraf yükleyerek görsel aramayı bilmiyordum. Öğrenmiş oldum sayinizde.