Sub AL_HyperLinks_Create()
'**********************************************************************
' 1. FUNCTIONAL DESCRIPTION of AL_HyperLink_Create
'
' Creates hyperlinks in a selected range.
' Each cell in the range must contain the full file and apth spec to a valid file.
'
' 2. REFERENCES - None
'
' 3. INPUTS - None
'
' 4. OUTPUTS - None
'
' 5. EXTERNAL EFFECTS
' Creates hyperlinks in the selected cells if those cells hold valid filespecs.
'
'**********************************************************************
Dim screenmessage As String, pathmsg As String, text2disp As String, celltext As String
Dim ext As String, nameonly As String, Path As String
Dim CreateHL As Integer, DispPath As Integer, numerrs As Integer, usrrows As Integer
Dim usrrange As Range, thiscell As Range
Dim badname As Boolean
On Error Resume Next
'give the user instructions and confirm he wants to continue
screenmessage = "This action creates hyperlinks from the data supplied" _
& Chr(13) & "in a specified range. The selected range must contain" _
& Chr(13) & "the full path and file descriptor of the files to be" _
& Chr(13) & "hyperlinked. The displayed text for the hyperlink may" _
& Chr(13) & "subsequently show (user choice) either the full path and" _
& Chr(13) & "filename or just the filename. Do you wish to continue?"
CreateHL = MsgBox(screenmessage, vbOKCancel, "Create Hyperlinks")
If CreateHL = 1 Then 'user selected "OK"
'get the user range selection
Set usrrange = get_user_range_selection()
'if he did not select cancel then proceed
usrrows = usrrange.Rows.count
If Err.Number <> 0 Then
Err.Clear
Else
'ask the user if he wants to display the filename and full path or just the filename
pathmsg = "When the Hyperlink is created, the displayed text can be " _
& Chr(13) & " the filename alone or the filename and whole path. " _
& Chr(13) & " If you would like to display the whole path, select YES," _
& Chr(13) & "to display Filename only, select NO, or to quit select Cancel"
DispPath = MsgBox(pathmsg, vbYesNoCancel, "Text to display")
'yes=6, no = 7, canc = 2
'if the user did not select cancel then proceed
If DispPath <> 2 Then
'step through each cell in the range
For Each thiscell In usrrange
'if the cell holds a valid (existing) file
celltext = thiscell.Text
badname = False
If celltext <> "" Then
If AL_FileExists(celltext) Then
'if the user selected full path then
If DispPath = 6 Then
'Text2disp = full cell content
text2disp = celltext
Else
'strip off the path and just use the filename alone
stripext celltext, ext, nameonly, Path, badname
text2disp = nameonly & ext
End If
'if the cell holds a valid path & file name then
If Not badname Then
'create a hyperlink to it using the above text2disp
thiscell.Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
Address:=celltext ', TextToDisplay:=text2disp
thiscell = text2disp
Else
'note the number of errors = numerrs
numerrs = numerrs + 1
End If
Else
'note the number of errors = numerrs
numerrs = numerrs + 1
End If
Else
'note the number of errors = numerrs
numerrs = numerrs + 1
End If
'end For loop
Next thiscell
End If
End If
'if any errors were found, tell the user
If numerrs > 0 Then MsgBox Str(numerrs) & " Errors were found.", vbOKOnly, "Warning!"
End If
End Sub
