Klasör içindeki jpg. dosyalarına köprü oluşturma

[hakanolsa]

excel koda ihtiyacım var. masa üstünde "resim" klasörü içindeki jpg. resimleri "e" sütünuna yukarıdan aşağıya artan sırada köprü oluşturacak.

 

[Haluk]

Sub Test()
    ' Haluk - 25/09/2018
    Dim FSO As Object, MyFolder As Object, MyFile As Object
    Dim strDocuments As String
    Dim i As Long
    
    Range("E2:E" & Rows.Count) = Empty
    Set WshShell = CreateObject("WScript.Shell")
    strDocuments = WshShell.SpecialFolders("Desktop")
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set MyFolder = FSO.GetFolder(strDocuments & Application.PathSeparator & "Resimler")
    i = 2
    
    For Each MyFile In MyFolder.Files
        If FSO.getExtensionName(MyFile) = "jpg" Then
            Range("E" & i) = FSO.getBaseName(MyFile)
            ActiveSheet.Hyperlinks.Add Anchor:=Range("E" & i), Address:=MyFile
            i = i + 1
        End If
    Next
    
    Set WshShell = Nothing
    Set MyFolder = Nothing
    Set FSO = Nothing
End Sub

.

 

[hakanolsa]

emeğinize çok teşekkür ederim.ancak masa üstünde köprüleme yapacak klasör (resim)ismini nereye yazacağımı bilemedim yardımcı olurmusunuz

 

[Haluk]

Klasörün adı zaten Resimler değilmiydi ?

 Set MyFolder = FSO.GetFolder(strDocuments & Application.PathSeparator & "Resimler")

Not: Sizin ilk mesajınızda Resimler değil Resim diye belirtmişiniz, ben dikkat etmemişim. Yukarıda kırmızı renkli yeri buna göre değiştirirsiniz.

.

 

[hakanolsa]

Çok teşekkür ederim büyük bir iyilik yaptın bana ) çalıştı

 

[hakanolsa]

Haluk bey farklı resim formatlarını nasıl ekleyebilirim tif,png gibi.

 

[Haluk]

Varsa, diğer resim uzantılarını aşağıdaki kodda arrPicExt dizi değişkenine tanımlayabilirsiniz.

Sub Test2()
    ' Haluk - 25/09/2018
    Dim FSO As Object, MyFolder As Object, MyFile As Object
    Dim arrPicExt As Variant, j As Long
    Dim strDocuments As String
    Dim i As Long
    
    Range("E2:E" & Rows.Count) = Empty
    Set WshShell = CreateObject("WScript.Shell")
    strDocuments = WshShell.SpecialFolders("Desktop")
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set MyFolder = FSO.GetFolder(strDocuments & Application.PathSeparator & "Resimler")
    i = 2
    
    arrPicExt = Array("gif", "png", "bmp", "jpeg", "jpg", "tif")
    
    For Each MyFile In MyFolder.Files
        For j = LBound(arrPicExt) To UBound(arrPicExt)
            If FSO.getExtensionName(MyFile) = arrPicExt(j) Then
                Range("E" & i) = FSO.getBaseName(MyFile)
                ActiveSheet.Hyperlinks.Add Anchor:=Range("E" & i), Address:=MyFile
                i = i + 1
            End If
        Next
    Next
    
    Erase arrPicExt
    Set WshShell = Nothing
    Set MyFolder = Nothing
    Set FSO = Nothing
End Sub

.

 

[gicimi]

@Haluk Bey Merhaba; klasörün içerisinde videolarda olur ise;

arrPicExt = Array("gif", "png", "bmp", "jpeg", "jpg", "tif")
"avi", "mp4" yazmamız yeterli olur mu_?

 

[Haluk]

Bir sıkıntı olmaz .... isterseniz "doc, xlsx, xlsm" bile olur ....

.

 

[gicimi]

Teşekkür ederim.

 

[hakanolsa]

Haluk bey , çok teşekkür ederim

 

[hakanolsa]

Haluk bey, köprü ekleme olmamış. köprüde resimlerin adresi olması gerekiyor. örnek: (C:\Users\hakan\Desktop\Resimler\53.jpg) indesing proğramında resimleri çağırmıyor.

 

[netzone]

Haluk bey, köprü ekleme olmamış. köprüde resimlerin adresi olması gerekiyor. örnek: (C:\Users\hakan\Desktop\Resimler\53.jpg) indesing proğramında resimleri çağırmıyor.

Merhaba,

@Haluk Bey'in yazmış olduğu kodlar Kullanıcı Klasörünüz altında Desktop Klasöründe bulunan Resimler Klasöründe yer alan belirttiğiniz uzantılı dosyaları listeleyip bu dosyalara bağlantı oluşturuyor.

Siz Adobe InDesign ile açmak istediğiniz dosyaların uzantılarını ilişkilendirmelisiniz. Bunun için;
- Başlat > Varsayılan uygulamalar yolunu izleyebilir.
- Yada (Örneğin JPG dosyası için) resim üzerinde sağ tuş > Birlikte aç > (Listede uygulama yoksa başka bir) uygulama seçerek varsayılan olarak atayabilirsiniz.

iyi çalışmalar.

 

[hakanolsa]

netzone Uzantıları ilişkilendirdim yinede olmadı

 

[netzone]

Her uzantı için ayrı ayrı ilişkilendirmeniz gerekiyor. Jpeg için yaptınız ayar Png veya diğerleri için geçerli olmayacaktır.
Lütfen kontrol edip dönüş yapınız.

 

[Tevfik_Kursun]

Haluk Bey,
Ben de teşekkür ederim
Saygılarımla

 

[hakanolsa]

şimdilik sadece jpg denedim çalışmadı ,
makro kodsus yeni excel sayfası açtığımda tek tek kendim köprü oluşturduğumda indesinde çalıştırıyor.

 

[hakanolsa]

sorunu hala çözemedim.Acil yardım

 

[hakanolsa]

dosya uzantusıyla köprüleme yapmasını istiyorum. örnek: masa üstünde resimler klasörü için. (C:\Users\hakan\Desktop\Resimler) excel de köprülendiği hüçrede bu uzantı olmadan çalışmıyor..