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
CellSave_Hyperlink "G4", , , "A1"
Put link in cell G5 that jumps to cell A1 in sheet Main in same workbook, with caption of "Back"
CellSave_Hyperlink "G5" , , , "A1", "Main", , , , "Back"
Puts link in cell G6 of sheet "Cmd" that jumps to website VBA.me, link name is "About" and screen tip is "About Programmer"
CellSave_Hyperlink "G6", "http://VBA.me", , , , , "Cmd", , "About", "About Programmer")

Views 2142 Downloads 856


ANmarAmdeen
612
Attachments
Components VBA-Excel
Revisions

v2.0