I can’t find anything off the top of my head to test whether there is a hyperlink on a shape or not (all logic fails with errors, bug?), so I present a very ugly solution:

Isolate the delete code by itself, try to delete for a shape, ignore any error. Not pretty, but works for me, Excel 2003

This code loops through all shapes on sheet1 and deletes the hyperlinks…

Sub DeleteAllShapeHyperlinks()
Sheet1.Activate

Dim GetShape As Shape

For Each GetShape In ActiveSheet.Shapes
KillHyperlink (GetShape.Name)
Next

End Sub

Function KillHyperlink(WhatShape As String)
On Error Resume Next
ActiveSheet.Shapes(WhatShape).Hyperlink.Delete
End Function

Sorry I can’t be more help,

Mark

Dim objexcel As Excel.Application
Dim objworksheet As Excel.Worksheet
Dim objworkbook As Excel.Workbooks

Private Sub cmddelete_Click()
Set objexcel = CreateObject(“Excel.Application”)
objexcel.Workbooks.Open (“c:test hyper.xls”)
objexcel.WindowState = xlMinimized
objexcel.WindowState = xlMaximized

Dim Shp As Excel.ShapeRange
Dim IShp As Excel.Shape
Dim i As Integer
Dim j As Integer
On Error GoTo ResNextShp
For j = 1 To objexcel.ActiveSheet.Shapes.Count
objexcel.ActiveSheet.Shapes(j).Select
Set Shp = Selection.ShapeRange
If Shp.HasDiagramNode = msoTrue Then
For i = 1 To Shp.DiagramNode.Diagram.Nodes.Count
Set IShp = Shp.DiagramNode.Diagram.Nodes(i).Shape
If IShp.Hyperlink.Address “” Then
IShp.Hyperlink.Delete
End If
Next i
End If
Set IShp = objexcel.ActiveSheet.Shapes(j)
If IShp.Hyperlink.Address “” Then
IShp.Hyperlink.Delete
End If
Next j
i = 0
For i = objexcel.ActiveSheet.Hyperlinks.Count To 1 Step -1
objexcel.ActiveSheet.Hyperlinks(i).Delete
Next i
Exit Sub

ResNextShp:
Resume Next

End Sub

Yet another way would be to use the looping code from this link: VBA Delete All Autoshapes, and the hyperlink.delete from my previous comment to remove all hyperlinks from all autoshapes.

ActiveSheet.Shapes(“AutoShape 1″).Select
Selection.ShapeRange.Item(1).Hyperlink.Delete