Thyag,
I have tried something. I hope this solves your problem... Copy the
following code and copy in a new code module in excel.
Option Explicit
Dim MainSht, ResultSht As Worksheet
Dim i, x As Integer
Sub Get_Hyperlinks()
Set MainSht = ActiveSheet
If Find_Sht_Exists = False Then
Set ResultSht = Sheets.Add
ResultSht.Name = "Link_" & MainSht.Name
ResultSht.Cells(1, 1) = "Object Name"
ResultSht.Cells(1, 2) = "Hyperlink name"
ResultSht.Range(Cells(1, 1), Cells(1, 2)).Select
Selection.Font.Bold = True
MainSht.Activate
For i = 1 To ActiveSheet.Shapes.Count
MainSht.Shapes(i).Select
On Error Resume Next
ResultSht.Cells(i + 1, 1) = Selection.ShapeRange.Item(1).Name
ResultSht.Cells(i + 1, 2) =
Selection.ShapeRange.Item(1).Hyperlink.Address
Next i
ResultSht.Columns("A:B").EntireColumn.AutoFit
ResultSht.Cells(2, 1).Select
ResultSht.Activate
MsgBox "Done"
Else
Exit Sub
End If
End Sub
Private Function Find_Sht_Exists() As Boolean
For x = 1 To Sheets.Count
If Sheets(x).Name = "Link_" & MainSht.Name Then
MsgBox "A sheet with name " & Chr(34) & "Link_" & MainSht.Name &
_
" already exists. Delete that and try again"
Find_Sht_Exists = True
Exit Function
End If
Next x
Find_Sht_Exists = False
End Function
I hope this helps. Let me know.
- selva
for more info on vba code and other programming posts, visit
http://socko.wordpress.com