converting hyperlink paths

I have an excel spreadsheet with hundreds of hyperlinks to pictures. These
pictures were stored in about 30 folders, so the hyperlinks contain the
paths to the pictures.

I have moved all the pictures, and the spreadsheet from 1 computer to
another. How can I write a script (VBA?) to go thur all the cells on each
worksheet looking for a hyperlink.
When a hyperlink is found it would parse the hyperlink and then access a
list to tell it how to convert the path of the hyperlink to reflect the
location of the picture on the new computer?



----== Posted via Newsfeeds.Com - Unlimited-Uncensored-Secure Usenet News==----
http://www.newsfeeds.com The #1 Newsgroup Service in the World! 120,000+ Newsgroups
----= East and West-Coast Server Farms - Total Privacy via Encryption =----

Hi

3 parts to this:

1) Find out where the "old" hyperlinks are in the active sheet (assumed it
is called "Sheet1"). To do this run "OldHyperlinks" which creates a new
sheet called Hypers. Column A and B of "Hypers" contain the cell address and
path of each hyperlink in Sheet1.
2) Amend Column B of "Hypers" to deal with the new path of each hyperlink.
3) Run "NewHyperlinks" to insert the new hyperlink paths on Sheet1.


Sub OldHyperlinks()
Application.ScreenUpdating = False
On Error Resume Next
Dim r As Range, c As Range, l As Long
Dim ws As Worksheet, s As String
Set r = Sheets("Sheet1").UsedRange
Set ws = Sheets.Add
ws.Name = "Hypers"
For Each c In r
s = c.Address
l = 0
l = Len(c.Hyperlinks(1).Address)
If l > 1 Then
ws.Range("A65000").End(xlUp).Offset(1, 0) = s
ws.Range("A65000").End(xlUp).Offset(0, 1) = _
c.Hyperlinks(1).Address
ws.Columns("A:A").Replace What:="$", _
Replacement:="", LookAt:=xlPart
End If
Next c
Application.ScreenUpdating = True
End Sub

Sub NewHyperlinks()
Application.ScreenUpdating = False
On Error Resume Next
Dim r As Range, c As Range
Dim s As String, str As String
With Sheets("Hypers")
Set r = .Range(.Range("A2"), _
..Range("A" & Rows.Count).End(xlUp))
End With
With Sheets("Sheet1")
For Each c In r
str = c.Offset(0, 1)
s = .Range(c).Text
..Range(c).Hyperlinks.Add Anchor:=.Range(c), _
Address:=str
..Range(c) = s
Next c
End With
Application.DisplayAlerts = False
Sheets("Hypers").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

--

XL2003
Regards

William
willwest22@yahoo.com


"Bill Sigl" <bsigl@awesomenet.net> wrote in message
news:42882a04$1_2@spool9-west.superfeed.net...
>I have an excel spreadsheet with hundreds of hyperlinks to pictures. These
>pictures were stored in about 30 folders, so the hyperlinks contain the
>paths to the pictures.
>
> I have moved all the pictures, and the spreadsheet from 1 computer to
> another. How can I write a script (VBA?) to go thur all the cells on each
> worksheet looking for a hyperlink.
> When a hyperlink is found it would parse the hyperlink and then access a
> list to tell it how to convert the path of the hyperlink to reflect the
> location of the picture on the new computer?
>
>
> ----== Posted via Newsfeeds.Com - Unlimited-Uncensored-Secure Usenet
> News==----
> http://www.newsfeeds.com The #1 Newsgroup Service in the World! 120,000+
> Newsgroups
> ----= East and West-Coast Server Farms - Total Privacy via Encryption
> =----

Bill

Just noticed that you want to carry out the process for all worksheets in
the workbook - use these subs instead

Sub OldHyperlinks()
Application.ScreenUpdating = False
On Error Resume Next
Dim r As Range, c As Range, l As Long
Dim ws As Worksheet, s As String
Dim ws1 As Worksheet
Set ws = Sheets.Add
ws.Name = "Hypers"
For Each ws1 In Worksheets
If Not ws1.Name = "Hypers" Then
Set r = ws1.UsedRange
For Each c In r
s = c.Address
l = 0
l = Len(c.Hyperlinks(1).Address)
If l > 1 Then
ws.Range("A65000").End(xlUp).Offset(1, 0) = s
ws.Range("A65000").End(xlUp).Offset(0, 1) = _
c.Hyperlinks(1).Address
ws.Range("A65000").End(xlUp).Offset(0, 2) = _
ws1.Name
End If
Next c
End If
Next ws1
ws.Columns("A:A").Replace What:="$", _
Replacement:="", LookAt:=xlPart
Application.ScreenUpdating = True
End Sub

Sub NewHyperlinks()
Application.ScreenUpdating = False
On Error Resume Next
Dim r As Range, c As Range
Dim s As String, str As String
Dim stg As String
With Sheets("Hypers")
Set r = .Range(.Range("A2"), _
..Range("A" & Rows.Count).End(xlUp))
End With
For Each c In r
str = c.Offset(0, 1)
stg = c.Offset(0, 2)
s = Sheets(stg).Range(c).Text
Sheets(stg).Range(c).Hyperlinks.Add Anchor:= _
Sheets(stg).Range(c), Address:=str
Sheets(stg).Range(c) = s
Next c
Application.DisplayAlerts = False
Sheets("Hypers").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

--


XL2003
Regards

William
willwest22@yahoo.com


"William" <willwest22@yahoo.com> wrote in message
news:u8hmtreWFHA.3184@TK2MSFTNGP15.phx.gbl...
> Hi
>
> 3 parts to this:
>
> 1) Find out where the "old" hyperlinks are in the active sheet (assumed
> it is called "Sheet1"). To do this run "OldHyperlinks" which creates a new
> sheet called Hypers. Column A and B of "Hypers" contain the cell address
> and path of each hyperlink in Sheet1.
> 2) Amend Column B of "Hypers" to deal with the new path of each hyperlink.
> 3) Run "NewHyperlinks" to insert the new hyperlink paths on Sheet1.
>
>
> Sub OldHyperlinks()
> Application.ScreenUpdating = False
> On Error Resume Next
> Dim r As Range, c As Range, l As Long
> Dim ws As Worksheet, s As String
> Set r = Sheets("Sheet1").UsedRange
> Set ws = Sheets.Add
> ws.Name = "Hypers"
> For Each c In r
> s = c.Address
> l = 0
> l = Len(c.Hyperlinks(1).Address)
> If l > 1 Then
> ws.Range("A65000").End(xlUp).Offset(1, 0) = s
> ws.Range("A65000").End(xlUp).Offset(0, 1) = _
> c.Hyperlinks(1).Address
> ws.Columns("A:A").Replace What:="$", _
> Replacement:="", LookAt:=xlPart
> End If
> Next c
> Application.ScreenUpdating = True
> End Sub
>
> Sub NewHyperlinks()
> Application.ScreenUpdating = False
> On Error Resume Next
> Dim r As Range, c As Range
> Dim s As String, str As String
> With Sheets("Hypers")
> Set r = .Range(.Range("A2"), _
> .Range("A" & Rows.Count).End(xlUp))
> End With
> With Sheets("Sheet1")
> For Each c In r
> str = c.Offset(0, 1)
> s = .Range(c).Text
> .Range(c).Hyperlinks.Add Anchor:=.Range(c), _
> Address:=str
> .Range(c) = s
> Next c
> End With
> Application.DisplayAlerts = False
> Sheets("Hypers").Delete
> Application.DisplayAlerts = True
> Application.ScreenUpdating = True
> End Sub
>
> --
>
> XL2003
> Regards
>
> William
> willwest22@yahoo.com
>
>
> "Bill Sigl" <bsigl@awesomenet.net> wrote in message
> news:42882a04$1_2@spool9-west.superfeed.net...
>>I have an excel spreadsheet with hundreds of hyperlinks to pictures.
>>These pictures were stored in about 30 folders, so the hyperlinks contain
>>the paths to the pictures.
>>
>> I have moved all the pictures, and the spreadsheet from 1 computer to
>> another. How can I write a script (VBA?) to go thur all the cells on
>> each worksheet looking for a hyperlink.
>> When a hyperlink is found it would parse the hyperlink and then access a
>> list to tell it how to convert the path of the hyperlink to reflect the
>> location of the picture on the new computer?
>>
>>
>> ----== Posted via Newsfeeds.Com - Unlimited-Uncensored-Secure Usenet
>> News==----
>> http://www.newsfeeds.com The #1 Newsgroup Service in the World! 120,000+
>> Newsgroups
>> ----= East and West-Coast Server Farms - Total Privacy via Encryption
>> =----
>
>