PDA

View Full Version : [SOLVED] Populate Hyperlinks in ListBox



Danny69
08-11-2013, 01:42 PM
Hello,
I am new to programming, I need this codes results in ListBox how to do that?


Sub HyperlinksToDirectory()
Dim stDir As String
Dim stFile As String
Dim R As Range
Set R = ActiveCell
stDir = InputBox("Directory?", , Default:=CurDir())
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
End Sub

SamT
08-11-2013, 06:28 PM
A ListBox can't hold hyperlinks.

What exactly are you trying to accomplish?

It looks like you're trying to populate a ListBox with file names and you want it to Open the selected file when clicked.

Danny69
08-11-2013, 10:20 PM
A ListBox can't hold hyperlinks.

Okay, i was not knowing that a listox can't hold hyperlinks.

What exactly are you trying to accomplish?
It looks like you're trying to populate a ListBox with file names and you want it to Open the selected file when clicked.

Yes, I want to populate the files names on ListBox from a particular folder, & if possible when clicked the selected file it opens.

Thanks.

Press
08-12-2013, 08:52 AM
Hi,

In a module include your procedure:

Sub HyperlinksToDirectory()
Cells(1, 1).Select
Dim stDir As String
Dim stFile As String
Dim R As Range
Set R = ActiveCell
stDir = InputBox("Directory?", , Default:=CurDir())
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
End Sub


Sub Avvia()
UserForm1.Show
End Sub


In Userform add:

Private Sub UserForm_Initialize()
Sheets("Foglio1").Activate
UserForm1.ListBox1.RowSource = ""
UserForm1.ListBox1.RowSource = "a1:a" & Range("A" & Rows.Count).End(xlUp).Row
End Sub


Private Sub ListBox1_Change()
If ListBox1.ListIndex < 0 Then Exit Sub
On Error Resume Next
Range(ListBox1.RowSource).Cells(ListBox1.ListIndex + 1, 1).Hyperlinks(1).Follow
Unload Me
On Error GoTo 0
End Sub

Danny69
08-13-2013, 08:33 PM
Thankyou, it works perfectly.