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
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.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.