Klasör Altındaki Pdf isimlerini linkli alma

[hasanyaprak]

Merhaba Arkadaşlar;
Aşağıdaki gibi bir makro kullanıyorum. Bu makro klasör altındaki pdf dökümanaları linkli olarak excele yazıyor.

Problemim hangi hücreden itibaren başlayacağımı her seferinde seçmemi istiyor. Yanlışlıkla/dalgınlıkla formüllü hücreyi seçmek gibi hata yapılabiliyor. Aktif sayfadaki A2 hücresine listelemesi için neleri değiştirmeliyim. Yardımcı olabilecek var mıdır? Şimdiden teşekkür ettim.

On Error Resume Next
Dim stDir As String
Dim stFile As String
Dim R As Range

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim fldr As FileDialog
Dim klasor_adi As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
fldr.Show
klasor_adi = fldr.SelectedItems.Item(1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.getfolder(klasor_adi)



' puts hyperlinks to each of the files in a directory of your choice
' into the active sheet starting at the active cell

Set R = ActiveCell
stDir = klasor_adi
stFile = Dir(stDir & "\*.pdf*")
Do Until stFile = ""
R.Hyperlinks.Add R, stDir & "\" & stFile, , , stFile
Set R = R.Offset(1)
stFile = Dir()
Loop
R.CurrentRegion.Sort key1:=R, order1:=xlAscending, Header:=xlNo
Selection.EntireColumn.AutoFit

 

[dEdE]

Set R = ActiveCell satırını Set R = [A2] şeklinde değiştirmeniz ve altına R.Activate satırını eklemeniz yeterli olacaktır.

 

[hasanyaprak]

Set R = ActiveCell satırını Set R = [A2] şeklinde değiştirmeniz ve altına R.Activate satırını eklemeniz yeterli olacaktır.

Teşekkür ederim dönüş için. Klasör seçimi yapıyorum ama excele listeleme yapmıyor.

On Error Resume Next
Dim stDir As String
Dim stFile As String
Dim R As Range

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim fldr As FileDialog
Dim klasor_adi As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
fldr.Show
klasor_adi = fldr.SelectedItems.Item(1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.getfolder(klasor_adi)



' puts hyperlinks to each of the files in a directory of your choice
' into the active sheet starting at the active cell

Set R = (A2)
R.Activate
stDir = klasor_adi
stFile = Dir(stDir & "\*.*")
Do Until stFile = ""
R.Hyperlinks.Add R, stDir & "\" & stFile, , , stFile
Set R = (A2)
stFile = Dir()
Loop
R.CurrentRegion.Sort key1:=R, order1:=xlAscending, Header:=xlNo
Selection.EntireColumn.AutoFit

 

[dEdE]

A2 ifadesi köşeli parantez içindeSet R = [A2] olacak. Ya da Set R=Range("A2") yazabilirsiniz.

 

[hasanyaprak]

A2 ifadesi köşeli parantez içindeSet R = [A2] olacak. Ya da Set R=Range("A2") yazabilirsiniz.

Hocam A sutununa yazmaya başladı fakat a1den başlıyor ve başlıkları aşağı atıyor(Sarı renkli görünen) / Ekran görüntüsü ekledim.

On Error Resume Next
Dim stDir As String
Dim stFile As String
Dim R As Range

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim fldr As FileDialog
Dim klasor_adi As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
fldr.Show
klasor_adi = fldr.SelectedItems.Item(1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.getfolder(klasor_adi)



' puts hyperlinks to each of the files in a directory of your choice
' into the active sheet starting at the active cell

Set R = Range("A2")
R.Activate
stDir = klasor_adi
stFile = Dir(stDir & "\*.*")
Do Until stFile = ""
R.Hyperlinks.Add R, stDir & "\" & stFile, , , stFile
Set R = R.Offset(1)
stFile = Dir()
Loop
R.CurrentRegion.Sort key1:=R, order1:=xlAscending, Header:=xlNo
Selection.EntireColumn.AutoFit

 

[hasanyaprak]

A2 ifadesi köşeli parantez içindeSet R = [A2] olacak. Ya da Set R=Range("A2") yazabilirsiniz.

 

[dEdE]

R.CurrentRegion.Sort key1:=R, order1:=xlAscending, Header:=xlNo satırındaki xlNo yerine xlYes yazarak dener misiniz?
Bir üst mesaja eklediğiniz dosya sadece .pdf değil tüm dosyaları listeler.

 

[hasanyaprak]

R.CurrentRegion.Sort key1:=R, order1:=xlAscending, Header:=xlNo satırındaki xlNo yerine xlYes yazarak dener misiniz?
Bir üst mesaja eklediğiniz dosya sadece .pdf değil tüm dosyaları listeler.

Teşekkür ettim. Çok güzel oldu.

 

[hasanyaprak]

Teşekkür ettim. Çok güzel oldu.

Hocam merhaba,
Ekteki dosyada daha önceden bir takım düzenlemeler yapmıştık. Gayet güzel çalışıyor. Normalde butona tıklayınca klasör açılıyor ve "A2" hücresinden başlayarak pdf isimlerini linkli listeliyor. Değişiklik yapmak istediğim 2.kez butona basmam durumunda farklı klasördeki dosyaları kalınan son yerden(Mesela ekli dosyada "A6" ) başlayarak yazmasını istersem nasıl bir düzenleme yapmalıyım. Yardım edebilir misin?