Hi;
Wondered if someone would help me make this work, and/or simplify.
Trying to convert all inserted/hyperlinks automatically to '=Hyperlin
Formulas', using the existing hyperlink-VALUE (NOT the address whic
are scr... up (relative paths horror)).

Any chance of tweaking this code to make it fly ?
Also, what should I put in the function name's parentheses?
Thanks.



Function FunctionCreateHLFormula()

Option Explicit

Dim MyPath As String
Dim HL As Hyperlink
Dim sh As Worksheet
Dim Currfile As String
Dim CurrWb As Workbook
Dim xlink As String
Dim cell As Range


On error goto FuncFail:

'Change this path to where the workbooks are
MyPath = "C:\Temp\Temp4\"

'Find the first xls file in the directory
Currfile = Dir(MyPath & "*.xls")


'Do while there is at least one xls file
Do While Currfile < ""
'Open the file
Set CurrWb = Workbooks.Open(MyPath & Currfile)
'Cycle through the sheets
For Each sh In CurrWb.Worksheets
'Cycle through the hyperlinks on the sheet
For Each HL In sh.Hyperlinks
'
xlink = cell.Value
cell.HL.Delete
cell.Formula = "=HYPERLINK(""" & xlink & """,""" & xlink & """)

'Mostly to open docs, pics on network shares
Next HL
Next sh
'Close the workbook
CurrWb.Close False
'Find the next xls file
Currfile = Dir
Loop


Set CurrWb = Nothing
Set sh = Nothing
Set HL = Nothing


End Sub


FuncFail:
MyPath=CvErr(xlErrValue)
HL=CvErr(xlErrValue)
sh=CvErr(xlErrValue)
Currfile=CvErr(xlErrValue)
Currwb=CvErr(xlErrValue)
xlink=CvErr(xlErrValue)
cell.Formula=CvErr(xlErrValue)
cell.value=CvErr(xlErrValue)

End Functio

--
Electro91
-----------------------------------------------------------------------
Electro911's Profile: http://www.excelforum.com/member.php...fo&userid=3194
View this thread: http://www.excelforum.com/showthread.php?threadid=51708

Let's say you have a table of hyperlinks in column A.

First enter this tiny UDF:

Function hyp2(r As Range) As String
hyp2 = r.Hyperlinks(1).Address
End Function


in B1 enter:
=A1 (the DisplayName)
in C1 enter:
=hyp2(A1) ( the URL)
in D1 enter:
=HYPERLINK(C1,B1) and there you are.
--
Gary's Student


"Electro911" wrote:


Hi;
Wondered if someone would help me make this work, and/or simplify.
Trying to convert all inserted/hyperlinks automatically to '=Hyperlink
Formulas', using the existing hyperlink-VALUE (NOT the address which
are scr... up (relative paths horror)).

Any chance of tweaking this code to make it fly ?
Also, what should I put in the function name's parentheses?
Thanks.



Function FunctionCreateHLFormula()

Option Explicit

Dim MyPath As String
Dim HL As Hyperlink
Dim sh As Worksheet
Dim Currfile As String
Dim CurrWb As Workbook
Dim xlink As String
Dim cell As Range


On error goto FuncFail:

'Change this path to where the workbooks are
MyPath = "C:\Temp\Temp4\"

'Find the first xls file in the directory
Currfile = Dir(MyPath & "*.xls")


'Do while there is at least one xls file
Do While Currfile < ""
'Open the file
Set CurrWb = Workbooks.Open(MyPath & Currfile)
'Cycle through the sheets
For Each sh In CurrWb.Worksheets
'Cycle through the hyperlinks on the sheet
For Each HL In sh.Hyperlinks
'
xlink = cell.Value
cell.HL.Delete
cell.Formula = "=HYPERLINK(""" & xlink & """,""" & xlink & """)"

'Mostly to open docs, pics on network shares
Next HL
Next sh
'Close the workbook
CurrWb.Close False
'Find the next xls file
Currfile = Dir
Loop


Set CurrWb = Nothing
Set sh = Nothing
Set HL = Nothing


End Sub


FuncFail:
MyPath=CvErr(xlErrValue)
HL=CvErr(xlErrValue)
sh=CvErr(xlErrValue)
Currfile=CvErr(xlErrValue)
Currwb=CvErr(xlErrValue)
xlink=CvErr(xlErrValue)
cell.Formula=CvErr(xlErrValue)
cell.value=CvErr(xlErrValue)

End Function


--
Electro911
------------------------------------------------------------------------
Electro911's Profile: http://www.excelforum.com/member.php...o&userid=31949
View this thread: http://www.excelforum.com/showthread...hreadid=517085

This worked with very basic hyperlinks:

Option Explicit
Sub CreateHLFormula()

Dim MyPath As String
Dim HL As Hyperlink
Dim sh As Worksheet
Dim Currfile As String
Dim CurrWb As Workbook
Dim xlink As String
Dim myCell As Range

MyPath = "C:\Temp\Temp4\"

Currfile = Dir(MyPath & "*.xls")

Do While Currfile < ""
Set CurrWb = Workbooks.Open(MyPath & Currfile)

For Each sh In CurrWb.Worksheets
For Each HL In sh.Hyperlinks
xlink = HL.Address
Set myCell = HL.Parent
HL.Delete
myCell.Formula _
= "=HYPERLINK(""" & xlink & """,""" & xlink & """)"
Next HL
Next sh
CurrWb.Close savechanges:=True 'True = Save it!
Currfile = Dir
Loop

End Sub



Electro911 wrote:

Hi;
Wondered if someone would help me make this work, and/or simplify.
Trying to convert all inserted/hyperlinks automatically to '=Hyperlink
Formulas', using the existing hyperlink-VALUE (NOT the address which
are scr... up (relative paths horror)).

Any chance of tweaking this code to make it fly ?
Also, what should I put in the function name's parentheses?
Thanks.

Function FunctionCreateHLFormula()

Option Explicit

Dim MyPath As String
Dim HL As Hyperlink
Dim sh As Worksheet
Dim Currfile As String
Dim CurrWb As Workbook
Dim xlink As String
Dim cell As Range

On error goto FuncFail:

'Change this path to where the workbooks are
MyPath = "C:\Temp\Temp4\"

'Find the first xls file in the directory
Currfile = Dir(MyPath & "*.xls")

'Do while there is at least one xls file
Do While Currfile < ""
'Open the file
Set CurrWb = Workbooks.Open(MyPath & Currfile)
'Cycle through the sheets
For Each sh In CurrWb.Worksheets
'Cycle through the hyperlinks on the sheet
For Each HL In sh.Hyperlinks
'
xlink = cell.Value
cell.HL.Delete
cell.Formula = "=HYPERLINK(""" & xlink & """,""" & xlink & """)"

'Mostly to open docs, pics on network shares
Next HL
Next sh
'Close the workbook
CurrWb.Close False
'Find the next xls file
Currfile = Dir
Loop

Set CurrWb = Nothing
Set sh = Nothing
Set HL = Nothing

End Sub

FuncFail:
MyPath=CvErr(xlErrValue)
HL=CvErr(xlErrValue)
sh=CvErr(xlErrValue)
Currfile=CvErr(xlErrValue)
Currwb=CvErr(xlErrValue)
xlink=CvErr(xlErrValue)
cell.Formula=CvErr(xlErrValue)
cell.value=CvErr(xlErrValue)

End Function

--
Electro911
------------------------------------------------------------------------
Electro911's Profile: http://www.excelforum.com/member.php...o&userid=31949
View this thread: http://www.excelforum.com/showthread...hreadid=517085

--

Dave Peterson

Hi, thanks for the fast help Dave.

What a relief, something that will work. Owe you a beer (Canadia
beer).


For the finishing touches;

1. Would you have a trick up your sleeve to retrieve the value (o
display text) of inserted/hyperlinks, instead of the HL.Address
which have already been trashed by the RHPD
...'Relative-Hyperlink-Path-Disease'. (I tried HL.value in you
macro - it blew up.) :)

The current resulting hyperlinks and display show:
file:///\\servername\..\..\sharename\filename.ext in my tes
files. (Obviously, I'll build a new test file from the operationa
workbook prior next tests.) ;)


2. For the display part of the =HyperlinkFormula, is there a way t
simply rip out the 'file:///' out of the display strings ?

3. Curiousity; Links used to work OK without using the -'file///'
pre-string. Is this pre-string a hold-over from previous versions o
Excell, or is it now essential for a reliable hyperlink jump of
=Hyperlink-Formulae ?

or, yet again, can it be safely be ripped out even off the hyperlin
itself ?


4. Goal is to get a clean display:
\\servername\sharename\filename.ext
and if possible, clean underlying hyperlinks as well... ... withou
RHPD ;)

Thank you

--
Electro91
-----------------------------------------------------------------------
Electro911's Profile: http://www.excelforum.com/member.php...fo&userid=3194
View this thread: http://www.excelforum.com/showthread.php?threadid=51708

I tried this:

= "=HYPERLINK(""" & *myCell* & """,""" & myCell & """)"

and the output looks a lot cleaner, with no RHPD.

It's getting late... so will test it on copy of production file
tomorrow to make sure all WORKS, ...and doesn't only 'look' good.

Much gratitude to you guys

--
Electro91
-----------------------------------------------------------------------
Electro911's Profile: http://www.excelforum.com/member.php...fo&userid=3194
View this thread: http://www.excelforum.com/showthread.php?threadid=51708

I changed it to point to the hyperlink address thinking that this is what you
wanted.

I guessed wrong.

Glad you got something that looks like it might work <bg.

Electro911 wrote:

I tried this:

= "=HYPERLINK(""" & *myCell* & """,""" & myCell & """)"

and the output looks a lot cleaner, with no RHPD.

It's getting late... so will test it on copy of production files
tomorrow to make sure all WORKS, ...and doesn't only 'look' good.

Much gratitude to you guys.

--
Electro911
------------------------------------------------------------------------
Electro911's Profile: http://www.excelforum.com/member.php...o&userid=31949
View this thread: http://www.excelforum.com/showthread...hreadid=517085

--

Dave Peterson

Hi Dave;
Actually it IS what I wanted, but the 'addresses' where already
sufferring from RHPD, so I looked for another way to get the clean
'paths' to set the HL formula by.
Very happy for the great help.
By the way, all works perfectly in operation too.
Thanks again.. I owe you two (Canadian) beers. :)


--
Electro911
------------------------------------------------------------------------
Electro911's Profile: http://www.excelforum.com/member.php...o&userid=31949
View this thread: http://www.excelforum.com/showthread...hreadid=517085

Glad you got it working.

Electro911 wrote:

Hi Dave;
Actually it IS what I wanted, but the 'addresses' where already
sufferring from RHPD, so I looked for another way to get the clean
'paths' to set the HL formula by.
Very happy for the great help.
By the way, all works perfectly in operation too.
Thanks again.. I owe you two (Canadian) beers. :)

--
Electro911
------------------------------------------------------------------------
Electro911's Profile: http://www.excelforum.com/member.php...o&userid=31949
View this thread: http://www.excelforum.com/showthread...hreadid=517085

--

Dave Peterson