PDA

View Full Version : Manage all Hyperlinks in Workbook from new Worksheet



blis
02-09-2010, 01:02 PM
Hello masters of VBA :) I am new to vba and asking for help.
I have a macro. It insert new list "SeznamHyperlink" and
- lists all hyperlinks from workbook in column A,
- for each hyperlink it returns address of hyperlink (sheetname!cellname) in column B,
- for each hyperlink it returns "friendly_name" in column C,
- for each hyperlink it returns "link_location" in column D and
- for each hyperlink it inset hyperlink function =hyperlink(columnD, columnC)

Here is the macro


Sub KopirajHyperlink()
Dim ws As Worksheet
Dim h_link As Long

On Error Resume Next
Application.DisplayAlerts = False
Sheets("SeznamHyperlink").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Sheets.Add().Name = "SeznamHyperlink"
For Each ws In Worksheets
If ws.Name <> "SeznamHyperlink" Then
For h_link = 1 To ws.UsedRange.Hyperlinks.Count
ws.Hyperlinks(h_link).Range.Copy
With Sheets("SeznamHyperlink").Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0).PasteSpecial
.Offset(1, 1) = ws.Hyperlinks(h_link).Range.Worksheet.Name & "!" & ws.Hyperlinks(h_link).Range.Address
.Offset(1, 2) = ws.Hyperlinks(h_link).Name
If ws.Hyperlinks(h_link).Address <> "" Then
.Offset(1, 3) = ws.Hyperlinks(h_link).Address
Else
.Offset(1, 3) = "#" & ws.Hyperlinks(h_link).SubAddress
End If
.Offset(1, 4) = "=Hyperlink(RC[-1], RC[-2])"
End With
Application.CutCopyMode = False
Next h_link
End If
Next ws
End Sub



Now to my problem. I would like to replace every founded hyperlink in workbook with hypelink formula. Formula should get its arguments from inserted worksheet "SeznamHyperlink" - "link_location" from column D and "friendly_name" from column C.

Can this be done? Thanks in advance

domfootwear
02-09-2010, 05:58 PM
Hello masters of VBA :) I am new to vba and asking for help.
I have a macro. It insert new list "SeznamHyperlink" and
- lists all hyperlinks from workbook in column A,
- for each hyperlink it returns address of hyperlink (sheetname!cellname) in column B,
- for each hyperlink it returns "friendly_name" in column C,
- for each hyperlink it returns "link_location" in column D and
- for each hyperlink it inset hyperlink function =hyperlink(columnD, columnC)

Here is the macro


Sub KopirajHyperlink()
Dim ws As Worksheet
Dim h_link As Long

On Error Resume Next
Application.DisplayAlerts = False
Sheets("SeznamHyperlink").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Sheets.Add().Name = "SeznamHyperlink"
For Each ws In Worksheets
If ws.Name <> "SeznamHyperlink" Then
For h_link = 1 To ws.UsedRange.Hyperlinks.Count
ws.Hyperlinks(h_link).Range.Copy
With Sheets("SeznamHyperlink").Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0).PasteSpecial
.Offset(1, 1) = ws.Hyperlinks(h_link).Range.Worksheet.Name & "!" & ws.Hyperlinks(h_link).Range.Address
.Offset(1, 2) = ws.Hyperlinks(h_link).Name
If ws.Hyperlinks(h_link).Address <> "" Then
.Offset(1, 3) = ws.Hyperlinks(h_link).Address
Else
.Offset(1, 3) = "#" & ws.Hyperlinks(h_link).SubAddress
End If
.Offset(1, 4) = "=Hyperlink(RC[-1], RC[-2])"
End With
Application.CutCopyMode = False
Next h_link
End If
Next ws
End Sub



Now to my problem. I would like to replace every founded hyperlink in workbook with hypelink formula. Formula should get its arguments from inserted worksheet "SeznamHyperlink" - "link_location" from column D and "friendly_name" from column C.

Can this be done? Thanks in advance

I don't understand your mean, but pls try this code:


Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim M As Long
M = 1
With Me
.Columns(1).ClearContents
.Cells(1, 1) = "List of sheets"
.Cells(1, 1).Name = "Index"
End With
For Each wSheet In Worksheets
If wSheet.Name <> Me.Name Then
M = M + 1
With wSheet
.Range("a1").Name = "Start" & wSheet.Index
.Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
SubAddress:="Index", TextToDisplay:="Back to Index"
End With
Me.Hyperlinks.Add Anchor:=Me.Cells(M, 1), Address:="", _
SubAddress:="Start" & wSheet.Index, TextToDisplay:=wSheet.Name
End If
Next wSheet
End Sub


Pls see att. file
http://www.4shared.com/file/218708989/6333d71b/Hyper_link.html

blis
02-10-2010, 10:57 AM
Hi domfootwear and thanks for helping.

let me explain myselft a bit more. For better understanding download workbook from

This workbook has several worksheets with multiple hyperlinks. Worksheet "SeznamHyperlink" is inserted with macro "kopirajHyperlink" (you can ran macro again and see for your selft). Macro copies all founded hyperlinks in a workbook to column A of inserted worksheet "SeznamHyperlink". It also returns address of hyperlink (sheetname!cellname) in column B, "friendly_name" in column C,"link_location" in column D and insets hyperlink function =hyperlink(columnD, columnC).

So macro lists all hyperlinks found. Now I am trying to change that macro so that it would replace each founded hyperlink with function hyperlink(). Arguments for hyperlink function should get form list "SeznamHyperlinks".

so, when i ran macro it finds first link in sheet "kazalo" cell E7. this hyperlink is copied to newly inserted worksheet "SeznamHyperlink" to column A (cell A2). then it fills apropriete data to column B (B2), C (C2), D (D2), E (E2). At this point i would like macro to replace this hiperlink found (sheet "Kazalo", cell "E7") with function "=hyperlink(SeznamHyperlink!D2, SeznamHyperlink!C2)". Next hyperlink is found in sheet "Kazalo", cell "E10" - macro should replace that hyperlink with function "=hyperlink(SeznamHyperlink!D3, SeznamHyperlink!C3) and soo on.

I hope you understand me. I know my english is far from perfect.

Thx for help.

blis
02-10-2010, 10:59 AM
i cant post link to document because i dont have enough posts....

blis
02-10-2010, 11:00 AM
still cant....

blis
02-10-2010, 11:00 AM
i am close to have 5 posts, so i can post a link to workbook....

lucas
02-10-2010, 11:01 AM
you can attach your file to your post. Select go advanced and then scroll down and look for a button that says, manage attachments.

blis
02-10-2010, 11:01 AM
http://www.4shared.com/file/219152868/5c062789/Katalog.html
link to workbook

blis
02-10-2010, 11:12 AM
Hey lucas.

I tried that but i had some problems with that. I hope you are not mad for my workaround :)

Now back to my macro. The main idea of that macro is to manage all hyperlinks in workbook from one sheet (SeznamHyperlink). I have 10 workbooks with at least 50 sheets and mio hyperlink. I need to find a way to manage hyperlinks from one sheet.

blis
02-12-2010, 10:44 AM
For Each ws In Worksheets
If ws.Name <> "SeznamHyperlink" Then
For h_link = 1 To ws.UsedRange.Hyperlinks.Count
ws.Hyperlinks(h_link).Range.Copy
With Sheets("SeznamHyperlink").Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0).PasteSpecial
.Offset(1, 1) = ws.Hyperlinks(h_link).Range.Worksheet.Name & "!" & ws.Hyperlinks(h_link).Range.Address
.Offset(1, 2) = ws.Hyperlinks(h_link).Name
If ws.Hyperlinks(h_link).Address <> "" Then
.Offset(1, 3) = ws.Hyperlinks(h_link).Address
Else
.Offset(1, 3) = "#" & ws.Hyperlinks(h_link).SubAddress
End If
.Offset(1, 4) = "=Hyperlink(RC[-1], RC[-2])"
End With

Here is the place to insert code...
i need to replace first founded hyperlink with formula
=hyperlink(SeznamHyperlink!D2, SeznamHyperlink!C2).
Second hyperlinks should be replaced with formula
which gets arguments from D3 and C3
(from sheet SeznamHyperlink)etc

Application.CutCopyMode = False
Next h_link
End If
Next ws


Pls someone help me.