CellSave_Hyperlink

Creates a hyperlink to URL or to cell inside a cell in Excel VBA (or delete it).
This is Hyperlink as Insert > Hyperlink and not as Hyperlink function.
Option to add hyperlink to online link, to a cell giving full cell address like [workbook.xlsx]Sheet1!A1, or as parts of workbook, worksheet and cell address.
If none of URL, FullAddress or CellAddress is given, that hyperlink will be deleted

More examples:
Puts link in Sheet2!G7 of this workbook to certain cell in certain workbook/worksheet
CellSave_Hyperlink "G7", , "[Workbook1.xlsb]Sheet5!D3:D6", , , , "Sheet2", "Main.xlsb", "Client List"

Function CellSave_Hyperlink(inCell_Addr, Optional ToURL = "", _
 Optional ToCell_FullAddress = "", _
 Optional ToCell_Address = "", Optional ToCell_Sheet = "This", Optional ToCell_WB = "This", _
 Optional InCell_Sheet = "This", Optional InCell_WB = "This", _
 Optional HCaption = "", Optional HTip = "")
 ' Line below will add hyperlink in a cell
 ' Not Hyperlink function, but the actual hyperlink
 ' Sheet1.Hyperlinks.Add Sheet1.Range("D5").Offset(I, 0), "", "'" & SheN & "'!A1", , SheN
 '
 If InCell_WB = "This" Then InCell_WB= ThisWorkbook.Name
 If ToCell_WB = "This" And InCell_WB > "" Then ToCell_WB = InCell_WB
 If ToCell_WB = "This" Then ToCell_WB = ThisWorkbook.Name
 If InCell_Sheet = "This" Then InCell_Sheet = Workbooks(InCell_WB).ActiveSheet.Name
 If ToCell_Sheet = "This" And InCell_Sheet > "" Then ToCell_Sheet = InCell_Sheet
 If ToCell_Sheet = "This" Then ToCell_Sheet = Workbooks(ToCell_WB).ActiveSheet.Name
 HRef1 = ""
 HRef2 = ""
 AddH = 0
 If ToURL = "" And ToCell_Address = "" And ToCell_FullAddress = "" Then
  ' Caller asked to remove hyperlink
  Workbooks(InCell_WB).Worksheets(InCell_Sheet).Range(inCell_Addr).Clear
 Else
  AddH = 1
  If ToURL > "" Then HRef1 = ToURL
  If ToCell_FullAddress > "" Then HRef2 = ToCell_FullAddress
  If ToCell_Address > "" Then HRef2 = "'[" & ToCell_WB & "]" & ToCell_Sheet & "'!" & ToCell_Address
  If HCaption = "" And HRef1 > "" Then HCaption = HRef1
  If HCaption = "" And HRef2 > "" Then HCaption = HRef2
 End If
 If AddH = 1 Then _
  Workbooks(InCell_WB).Worksheets(InCell_Sheet).Add Workbooks(InCell_WB).Worksheets(InCell_Sheet).Range(inCell_Addr), _
   HRef1, HRef2 , HTip, HCaption
 End If
End Function

inCell_Addr, Optional ToURL, Optional ToCell_FullAddress, Optional ToCell_Address, Optional ToCell_Sheet, Optional ToCell_WB, Optional InCell_Sheet, Optional InCell_WB, Optional HCaption, Optional HTip

Put link in cell G4 that jumps to A1 in same sheet<br/> CellSave_Hyperlink &#34;G4&#34;, , , &#34;A1&#34;<br/>Put link in cell G5 that jumps to cell A1 in sheet Main in same workbook, with caption of &#34;Back&#34;<br/> CellSave_Hyperlink &#34;G5&#34; , , , &#34;A1&#34;, &#34;Main&#34;, , , , &#34;Back&#34;<br/>Puts link in cell G6 of sheet &#34;Cmd&#34; that jumps to website VBA.me, link name is &#34;About&#34; and screen tip is &#34;About Programmer&#34;<br/> CellSave_Hyperlink &#34;G6&#34;, &#34;http://VBA.me&#34;, , , , , &#34;Cmd&#34;, , &#34;About&#34;, &#34;About Programmer&#34;)<br/>

Views 238 Downloads 95

'hyperlink', 'link', 'url', 'http', 'www', 'address', 'sheet', 'workbook', 'click', 'open'

ANmarAmdeen
313
Attachments
Components VBA-Excel
Revisions

v2.0