Public hb As String
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If IsEmpty(hb) Or Len(hb) = 0 Then
For Each i In Sh.Parent.BuiltinDocumentProperties
If i.Name = "Hyperlink base" Then
hb = i.Value
If IsEmpty(hb) Or Len(hb) = 0 Then
hb = Sh.Parent.Path
End If
End If
Next
End If
For Each h In Target.Hyperlinks
If InStr(1, h.Address, "//", vbBinaryCompare) = 0 And InStr(1, h.Address, ":\", vbBinaryCompare) = 0 Then