Klasörden dosya çekmek

[sosorry]

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?

 

[leumruk]

Merhaba,
Ana_Dosya' nın A1 hücresine dosya ismini girip Enter'layın. Uzantı girmenize gerek yok.

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.

 

[sosorry]

Merhaba,
Ana_Dosya' nın A1 hücresine dosya ismini girip Enter'layın. Uzantı girmenize gerek yok.

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.

belirtilen adlı öğe bulunamadı hatası veriyor.?

 

[leumruk]

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.

 

[sosorry]

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.

aynen öyle yaptım. hatayı ekledim.

 

[leumruk]

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.

 

[sosorry]

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.

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

 

[leumruk]

Tüm kodu aşağıdakiyle değiştirip sonucu bildirir misiniz?

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

 

[sosorry]

Tüm kodu aşağıdakiyle değiştirip sonucu bildirir misiniz?

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

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? )

 

[leumruk]

Kodu aşağıdakiyle değiştirin. A1 hücresine çift tıkladığınızda çalışır.

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

 

[sosorry]

Kodu aşağıdakiyle değiştirin. A1 hücresine çift tıkladığınızda çalışır.

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

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.

 

[Erdem Akdemir]

arkadaşlar aynı işlemi rar'lı dosyadan çıkartarak nasıl yaparız

günlerdir buna kafa patlatıyorum, sonuç sıfır

 

[leumruk]

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.

 

[sosorry]

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.

çok oldum ama bu son bir de a1 den a 10 a kadar nasıl olan hücrelerde nasıl kullanabilirim?

 

[leumruk]

Diğer sorunuzu yeni gördüm. Aralığı genişletmek için aşağıdaki satırı kullanacaksınız.

If Intersect(Target, [a1]) Is Nothing Or Target = "" Then Exit Sub

Bunun yerine:

If Intersect(Target, [[COLOR="Red"]a1:a10[/COLOR]]) Is Nothing Or Target = "" Then Exit Sub

yazmalısınız.

 

[sosorry]

Diğer sorunuzu yeni gördüm. Aralığı genişletmek için aşağıdaki satırı kullanacaksınız.

If Intersect(Target, [a1]) Is Nothing Or Target = "" Then Exit Sub

Bunun yerine:

If Intersect(Target, [[COLOR="Red"]a1:a10[/COLOR]]) Is Nothing Or Target = "" Then Exit Sub

yazmalısınız.

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

 

[leumruk]

Gözümden kaçmış. Aşağıdaki kodu kullanın.

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

 

[sosorry]

Gözümden kaçmış. Aşağıdaki kodu kullanın.

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

evet oldu. gece gece oldukça yordum sizi elinize kolunuza sağlık çok teşekkür ederim.

 

[leumruk]

evet oldu. gece gece oldukça yordum sizi elinize kolunuza sağlık çok teşekkür ederim.

Rica ederim. İyi geceler...

 

[sosorry]

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.