Resimlere Otomatik Köprü Oluşturma

  • Konuyu başlatan Konuyu başlatan vurkan
  • Başlangıç tarihi Başlangıç tarihi
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...

vurkan

Kullanıcı
Excel Versiyonu
Excel 2016
Excel Sürümü
64 Bit
Excel Dili
Türkçe
Arkadaşlar merhaba. Okulumda geçmiş yıllara ait bir diploma defteri programı oluşturmaya çalışıyorum. Arşivdeki diploma defterlerinin her sayfasının resmini çektim. ve sayfa isimlerini sayfadaki diploma numaralarının başlama ve bitiş numaralarına göre (örneğin 14-25) isimlendirdim. Ayrıca klasörler oluşturarak (2003-2004 şeklinde isimlendirdim) bu sayfaları ait oldukları klasörlere yerleştirdim. Bu klasörleri de DİPLOMA DEFTER RESİMLERİ isimli klasörde topladım. Ekteki örnek defter dosyası ile bu klasör aynı ortamda olacak. (mesela masa üstü veya diploma isimli klasör.)

Yapmak istediğim; Mesela:
Örnek defter dosyası çalıştırılıp Sonuc sayfasında ALİ VELİ isimli kişi aranıp bulununca H sütununda diploma numarası 16 olarak göründü. Bu 16 rakamına J sütunundaki eğitim öğretim yılı (aynı satırdaki) aynı zamanda DİPLOMA DEFTER RESİMLERİ klasöründeki aynı isimli klasör içindeki 14-25 isimli resme köprü kurmak istiyorum.

Yani 16 ya tıklayınca DİPLOMA DEFTER RESİMLERİ klasöründeki (J sütunundaki) ilgili klasöre gidecek ve 16, 14 ile 25 arasında olduğu için 14-25 isimli resmi açacak. Bu mümkün müdür acaba? Bunun için nasıl bir kod yazılmalıdır. Saygılar.
 
Userform Üzerinde Listbox Koşullu Veri Sayma
Fonksiyon ile En Son Satırı Bulma

Ekli dosyalar

Tarihe göre sırala Oylamaya göre sırala
Alt taraftan sonuc isimli sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin ve
karşınıza gelecek VBA ekranında sağdaki boş alana aşağıdaki kodları yapıştırın.

Artık H sütunundaki hücreye fareyle çift tıkladığınızda ilgili resim açılacaktır.

VBA: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row < 5 Or Target.Column <> 8 Or Target.Value = Empty Then Exit Sub
    Dim kls As Object, dsy As Object, resim As Object, rsm As Object
    Set kls = Interaction.CreateObject("Scripting.FileSystemObject")
    Set dsy = kls.GetFolder(ThisWorkbook.Path & "\DİPLOMA DEFTER RESİMLERİ\" & Target.Offset(0, 2).Text)
    Set resim = dsy.Files
    For Each rsm In resim
        isim = Replace(rsm.Name, ".jpg", "")
        bir = Val(Split(isim, "-")(0)): iki = bir
        If InStr(isim, "-") > 0 Then iki = Val(Split(isim, "-")(1))
        If bir <= Target.Value And iki >= Target.Value Then
            CreateObject("Shell.Application").Open rsm.Path: Exit For
        End If
    Next rsm: Cancel = True
    Set rsm = Nothing: Set resim = Nothing: Set dsy = Nothing: Set kls = Nothing
End Sub

.
 
Oyla 0 Olumsuz oyla
Sayın BARAN Üstadım ilginite teşekkür ederim. Kodlar genelde çalıştı.
Ancak. Diploma defterinde son sayfada tek kişi olunca o sayfaya sadece onun diploma numarasını isim olarak vermiştim. 1808 gibi. Bu öğrenciyi görüntülemek istediğimde hata verdi. Diğer öğrencilerde sorun çıkmıyor. Bunun gibi birkaç öğrenci daha var. Nasıl bir değişiklik yapılabilir. Saygılar sunuyorum.
 
Oyla 0 Olumsuz oyla
Kırmızı renklendirdiğim satırların arasını şöyle değiştirin.

NOT: Önceki kod cevabımı buna göre güncelledim.

VBA: 
................
        isim = Replace(rsm.Name, ".jpg", "")
        bir = Val(Split(isim, "-")(0)): iki = bir
        If InStr(isim, "-") > 0 Then iki = Val(Split(isim, "-")(1))
        If bir <= Target.Value And iki >= Target.Value Then
......................
 
Oyla 0 Olumsuz oyla
Çözüm
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst