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