• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Klasörden dosya çekmek

sosorry

sosorry

Katılım
17 Ocak 2007
Mesajlar
193
Excel Vers. ve Dili
Office 365
iyi geceler,
gene bir soru, elimde 1 adet klasör var -xxx kalsörü-; klasörün içinde a.xls, b.xls ve c.xls isimli 3 adet kitap var. ben d.xls kitabının A1 kutucuğuna a.xls yazdığımda xxx kalsöründeki a.xls ye direk linklenebilecek bi kod yazabilir miyim?
 
Merhaba,
Ana_Dosya' nın A1 hücresine dosya ismini girip Enter'layın. Uzantı girmenize gerek yok.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a1]) Is Nothing Or Target = "" Then Exit Sub
Dosya = [a1].Text
    With Application.FileSearch
    .LookIn = ThisWorkbook.Path & "\xxx"
    .Filename = Dosya & ".xls"
    If .Execute() > 0 Then
    CreateObject("Shell.Application").Open ThisWorkbook.Path & "\xxx\" & Dosya & ".xls"
    Else
    MsgBox "Bu isimde bir dosya bulunmamaktadır.", vbCritical, "Dosya Bulunamadı"
    End If
    End With
End Sub
Klasörü rar dosyasından çıkarmayı unutmayın.
 

Ekli dosyalar

leumruk' Alıntı:
Merhaba,
Ana_Dosya' nın A1 hücresine dosya ismini girip Enter'layın. Uzantı girmenize gerek yok.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a1]) Is Nothing Or Target = "" Then Exit Sub
Dosya = [a1].Text
    With Application.FileSearch
    .LookIn = ThisWorkbook.Path & "\xxx"
    .Filename = Dosya & ".xls"
    If .Execute() > 0 Then
    CreateObject("Shell.Application").Open ThisWorkbook.Path & "\xxx\" & Dosya & ".xls"
    Else
    MsgBox "Bu isimde bir dosya bulunmamaktadır.", vbCritical, "Dosya Bulunamadı"
    End If
    End With
End Sub
Klasörü rar dosyasından çıkarmayı unutmayın.
Genişletmek için tıkla ...


belirtilen adlı öğe bulunamadı hatası veriyor.?
 
Klasörü rardan çıkarmış olmanız gerekli. Eklediğim dosyayı kendi klasöründen çıkarmamalısınız. Belki dosyanın uzantısını da yazmış olabilirsiniz. xxx klasörüne a, b, c adında 3 dosya ekledim bunlardan birini yazmalısınız. Örneğin: a gibi.
 
leumruk' Alıntı:
Klasörü rardan çıkarmış olmanız gerekli. Eklediğim dosyayı kendi klasöründen çıkarmamalısınız. Belki dosyanın uzantısını da yazmış olabilirsiniz. xxx klasörüne a, b, c adında 3 dosya ekledim bunlardan birini yazmalısınız. Örneğin: a gibi.
Genişletmek için tıkla ...

aynen öyle yaptım. hatayı ekledim.
 

Ekli dosyalar

  • adsız.jpg
    adsız.jpg
    93.7 KB · Görüntüleme: 17
Sanırım 2007 kullanıyorsunuz, sorunun sebebi bu olabilir. Hata verdiğinde Debug'a tıklayıp hata satırını ekler misiniz? Alternatif bir kod deneyeyim.
 
leumruk' Alıntı:
Sanırım 2007 kullanıyorsunuz, sorunun sebebi bu olabilir. Hata verdiğinde Debug'a tıklayıp hata satırını ekler misiniz? Alternatif bir kod deneyeyim.
Genişletmek için tıkla ...

emeğinize sağlık olursa çok güzel olcak benim için...
 

Ekli dosyalar

  • adsız 2.jpg
    adsız 2.jpg
    93.5 KB · Görüntüleme: 8
Tüm kodu aşağıdakiyle değiştirip sonucu bildirir misiniz?
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a1]) Is Nothing Or Target = "" Then Exit Sub
Dosya = [a1].Text
    If Dir$(ThisWorkbook.Path & "\xxx\" & Dosya & ".xls") <> "" Then
    CreateObject("Shell.Application").Open ThisWorkbook.Path & "\xxx\" & Dosya & ".xls"
    Else
    MsgBox "Bu isimde bir dosya bulunmamaktadır.", vbCritical, "Dosya Bulunamadı"
    End If
End Sub
 
leumruk' Alıntı:
Tüm kodu aşağıdakiyle değiştirip sonucu bildirir misiniz?
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a1]) Is Nothing Or Target = "" Then Exit Sub
Dosya = [a1].Text
    If Dir$(ThisWorkbook.Path & "\xxx\" & Dosya & ".xls") <> "" Then
    CreateObject("Shell.Application").Open ThisWorkbook.Path & "\xxx\" & Dosya & ".xls"
    Else
    MsgBox "Bu isimde bir dosya bulunmamaktadır.", vbCritical, "Dosya Bulunamadı"
    End If
End Sub
Genişletmek için tıkla ...

süper. evet çalıştı. çok teşekkür ederim. peki b orada yazılı kalsın ben b' ye tıkladığımda b.xls yi alsın. yani her seferinde ayrı ayrı yazmiim. şirkette teklif formları excel sayfasında liste yapacağım ben listeye tüm teklif isimlerini gireceğim tek bir excel sayfasında liste halinde olacak. örnek a1 kutucuğunda 004 nolu teklif olacak ben tıkladığımda 004 nolu teklif açılacak.
(açıklayabildim umarım? )
 
Kodu aşağıdakiyle değiştirin. A1 hücresine çift tıkladığınızda çalışır.
Kod: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [a1]) Is Nothing Or Target = "" Then Exit Sub
Cancel = True
Dosya = [a1].Text
    If Dir$(ThisWorkbook.Path & "\xxx\" & Dosya & ".xls") <> "" Then
    CreateObject("Shell.Application").Open ThisWorkbook.Path & "\xxx\" & Dosya & ".xls"
    Else
    MsgBox "Bu isimde bir dosya bulunmamaktadır.", vbCritical, "Dosya Bulunamadı"
    End If
End Sub
 
leumruk' Alıntı:
Kodu aşağıdakiyle değiştirin. A1 hücresine çift tıkladığınızda çalışır.
Kod: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [a1]) Is Nothing Or Target = "" Then Exit Sub
Cancel = True
Dosya = [a1].Text
    If Dir$(ThisWorkbook.Path & "\xxx\" & Dosya & ".xls") <> "" Then
    CreateObject("Shell.Application").Open ThisWorkbook.Path & "\xxx\" & Dosya & ".xls"
    Else
    MsgBox "Bu isimde bir dosya bulunmamaktadır.", vbCritical, "Dosya Bulunamadı"
    End If
End Sub
Genişletmek için tıkla ...

harika oldu. ne kadar teşekkür etsem az zihninize, elinize sağlık. xxx yazan yerleri dosya adı ile değiştirdiğimde heryerde kullanabilirim sanırım değil mi? bir de a1 den a 10 a kadar nasıl olan hücrelerde nasıl kullanabilirim?
çok teşekkür ederim.
 
Son düzenleme:
arkadaşlar aynı işlemi rar'lı dosyadan çıkartarak nasıl yaparız

günlerdir buna kafa patlatıyorum, sonuç sıfır
 
xxx, açmak istediğiniz dosyaların bulunduğu klasörün adı. Klasör ismini değiştirdiğinizde koddaki yerine adını eklemeniz gerekli. Sizin söylediğiniz gibi xxx kısmına yeni klasör adını eklemelisiniz. Ana_Dosya'nın yerini değitirmediğiniz sürece kodu farklı klaör isimleriyle kullanabilirsiniz. Ana_Dosya'yı klasör dışına çıkaracaksanız dosya yolunun yeniden yazılması gerekir.
 
leumruk' Alıntı:
xxx, açmak istediğiniz dosyaların bulunduğu klasörün adı. Klasör ismini değiştirdiğinizde koddaki yerine adını eklemeniz gerekli. Sizin söylediğiniz gibi xxx kısmına yeni klasör adını eklemelisiniz. Ana_Dosya'nın yerini değitirmediğiniz sürece kodu farklı klaör isimleriyle kullanabilirsiniz. Ana_Dosya'yı klasör dışına çıkaracaksanız dosya yolunun yeniden yazılması gerekir.
Genişletmek için tıkla ...

çok oldum ama bu son :) bir de a1 den a 10 a kadar nasıl olan hücrelerde nasıl kullanabilirim?
 
Diğer sorunuzu yeni gördüm. Aralığı genişletmek için aşağıdaki satırı kullanacaksınız.
Kod: 
If Intersect(Target, [a1]) Is Nothing Or Target = "" Then Exit Sub
Bunun yerine:
Kod: 
If Intersect(Target, [[COLOR="Red"]a1:a10[/COLOR]]) Is Nothing Or Target = "" Then Exit Sub
yazmalısınız.
 
leumruk' Alıntı:
Diğer sorunuzu yeni gördüm. Aralığı genişletmek için aşağıdaki satırı kullanacaksınız.
Kod: 
If Intersect(Target, [a1]) Is Nothing Or Target = "" Then Exit Sub
Bunun yerine:
Kod: 
If Intersect(Target, [[COLOR="Red"]a1:a10[/COLOR]]) Is Nothing Or Target = "" Then Exit Sub
yazmalısınız.
Genişletmek için tıkla ...

ekledim ama a1 de hangisi yazılı ise onu açıyor. yani a1 de a yazıo, a4 te b yazıo a.xls yi açıyor :S
 
Gözümden kaçmış. Aşağıdaki kodu kullanın.
Kod: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [a1:a10]) Is Nothing Or Target = "" Then Exit Sub
Cancel = True
Dosya = [COLOR="Red"]Target[/COLOR].Text
    If Dir$(ThisWorkbook.Path & "\xxx\" & Dosya & ".xls") <> "" Then
    CreateObject("Shell.Application").Open ThisWorkbook.Path & "\xxx\" & Dosya & ".xls"
    Else
    MsgBox "Bu isimde bir dosya bulunmamaktadır.", vbCritical, "Dosya Bulunamadı"
    End If
End Sub
 
leumruk' Alıntı:
Gözümden kaçmış. Aşağıdaki kodu kullanın.
Kod: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [a1:a10]) Is Nothing Or Target = "" Then Exit Sub
Cancel = True
Dosya = [COLOR="Red"]Target[/COLOR].Text
    If Dir$(ThisWorkbook.Path & "\xxx\" & Dosya & ".xls") <> "" Then
    CreateObject("Shell.Application").Open ThisWorkbook.Path & "\xxx\" & Dosya & ".xls"
    Else
    MsgBox "Bu isimde bir dosya bulunmamaktadır.", vbCritical, "Dosya Bulunamadı"
    End If
End Sub
Genişletmek için tıkla ...

evet oldu. :) gece gece oldukça yordum sizi elinize kolunuza sağlık çok teşekkür ederim.
 
tekrar selam,
bu kodu kendi klasörüme uyguladım ve çalışıyor, tekrar çok teşekkür ederim. konu hakkında tekrar bişi sorcam, hücreye yazılmış olan kitap isimleri çok uzun ve aynen yazılması gerekiyor. bu kitaplar 0100 gibi 4 haneli sayılarla başlıyor. hücreye yanlızca ilk 4 hane girilerek o kitabı çağırma gibi bir kod yazılabilir mi? şimdiden çok teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst