Hücre içeriği ile klasör oluşturma

[gokhanbarut]

Merhaba,
Aşağıda özetlediğim işlev üzerinde uğraştım ama başarılı olamadım, yardımcı olabilir misiniz?

A sütununa kullanıcı numaralar girecek, excel A sütunundaki ilgili hücreye girilen numarayla excel dosyasının bulunduğu klasörün içinde yeni bir klasör oluşturacak ve bu klasörü o hücreye linkleyecek.
Örneğin; kullanıcı A1 hücresine "1234" verisini girdikten sonra excel "1234" isimli bir klasör açacak ve ve bu klasörü A1 hücresine linkleyecek. Kullanıcı bu linki kullanarak dosyayı açacak ve içerisine atacağı evrakları atacak.
Kullanıcı daha sonra A2-A3-A4... hücrelerine de veri girdiğinde aynı işlemi tekrarlayabilecek.

Yardımınız için şimdiden teşekkürler

 

[muygun]

Merhaba;
Sayfanın kod bölümüne;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
sat = Target.Row
If WorksheetFunction.CountIf(Range("A1:A" & sat), Cells(sat, "A")) > 1 Then Cells(sat, "A").Delete
If Cells(sat, "a") <> "" Then
Set kls = CreateObject("Scripting.FileSystemObject")
yol = ThisWorkbook.Path & "\" & Cells(sat, "a")
a = kls.FolderExists(yol)
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=yol
kls.CreateFolder yol
End If
End Sub

Kodlarını ekleyin ve dosyanızı kaydedin.
Sonra A sütununda bir isim yazarak deneyin.
İyi çalışmalar.

 

[gokhanbarut]

Merhaba,
Çok teşekkür ederim. A1 hücresine bir değer yazdığımda o isme bir kalsör açıp linkliyor. Buraya kadar güzel ama sonrasında B1,C1,D1... aynı satırdaki diğer hücrelere tıkladığımda yine aynı dosyayı linkliyor. Sadece A sütunundaki ilgili hücreye linklemesini nasıl sağlayabilirim.

 

[muygun]

Merhaba;
Kodları;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
sat = Target.Row
süt = Target.Column
If süt = 1 Then
If WorksheetFunction.CountIf(Range("A1:A" & sat), Cells(sat, "A")) > 1 Then Cells(sat, "A").Delete
If Cells(sat, "a") <> "" Then
Set kls = CreateObject("Scripting.FileSystemObject")
yol = ThisWorkbook.Path & "\" & Cells(sat, "a")
a = kls.FolderExists(yol)
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=yol
kls.CreateFolder yol
End If
End If
End Sub

Şeklinde değiştirerek deneyin.
İyi çalışmalar.

 

[gokhanbarut]

Hocam tekrar merhaba,
Size zahmet veriyorum ama bu sefer de A1 hücresine kurduğu linki tüm A sütununa kurdu. A2,A3,A4..... gibi bütün hücrelere A1'e kurduğu linki kurdu. A2'ye yeni bir isim girdiğimde o isimde klasör oluşturdu ama linklemedi, A1'in linki tüm A sütununda kalmaya devam etti.
Yardımcı olabilirseniz sevinirim

 

[muygun]

Örnek dosya ekleyin. (sorunu anlamadım)