Hi All,
I've created a macro in excel where each cell should hyperlink to a PDF.
ex. cell C5 should hyperlink to a file called 'C5'.
I had these files on my desktop and it was working just fine, but now i need to change the path to '\\werver\www\live\PARK\' and i can't seem to get it to work..
Does anyone have any suggestions?
I've created a macro in excel where each cell should hyperlink to a PDF.
ex. cell C5 should hyperlink to a file called 'C5'.
I had these files on my desktop and it was working just fine, but now i need to change the path to '\\werver\www\live\PARK\' and i can't seem to get it to work..
Does anyone have any suggestions?
Sub Link_Em()
' loop through all of the cells in the range and create a hyperlink for each
' cell to a pdf document with the same name
Dim cl As Range
Dim rng As Range
Dim Path As String ' the path to the documents
Path = GetDesktop & "\Zan\Widd\Quotes2\Quote Templates\PDF"
' On Error GoTo err_handler
Set rng = Sheet1.Range("b4:O20").Cells.SpecialCells(xlCellTypeConstants)
Application.ScreenUpdating=False
For Each cl In rng
With cl
If IsNumeric(.Value) Then
' delete any existing hyperlinks
If (.Hyperlinks.Count <> 0) Then .Hyperlinks(1).Delete
.Hyperlinks.Add cl, Path & .Address(False, False) & ".pdf"
.BorderAround ColorIndex:=1, Weight:=xlThin
.NumberFormat = _
"_-[$$-409]* #,##0.00_ ;_-[$$-409]* -#,##0.00 ;_-[$$-409]* ""-""??_ ;_-@_ "
End If
End With
Next cl
exit_proc:
Application.ScreenUpdating = True
Exit Sub
err_handler:
MsgBox "No cells with values in range", vbCritical, "Error"
Resume exit_proc
End Sub
Public Function GetDesktop() As String
GetDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
Application.PathSeparator
End Function