remove hyperlinks

I am trying to remove hyperlink from excel sheet.

I am able to remove hyperlink from auto shapes like callouts, arrow...

its working for images also.

only hyperlinks from organization chart is not goin....



if u see code given below... its not counting the hyperlinks in the organization chart.. i.e. they r not deleted...

Code:

---


MsgBox (wSheet.Hyperlinks.Count)
                        For i = wSheet.Hyperlinks.Count To 1 Step -1
                           
                            If cancelPwd = True Then
                              Exit For
                            End If

                            If wSheet.Hyperlinks(i).Type <> 0 Then
                              wSheet.Hyperlinks(i).Delete
                              ObjExcel.Save
                            End If
                        Next i

---

You will need to select the shape itself in code and then remove the link from within the shape, it will not show up on the hyperlinks in the spreadsheet..

VB Code:

ActiveSheet.Shapes("Organization Chart").Select
Selection.ShapeRange.Item(1).Hyperlink.Delete 'Change to the item number or name

but then i have to explicitely give this for every graphical object..
dont u think?

is there a groupname for all the graphical objects which i can give? which i can give ..... like i can replace organization chart with that name....

ActiveSheet.Shapes("Organization Chart").Select
Selection.ShapeRange.Item(1).Hyperlink.Delete 'Change to the item number or name

the code snippet given by u is not working...
have u checked it anytime?

It was what was showed up on a recorded macro.. trying to run it a second time fails to work, there will be another way..

its not working for the first time also

Okay.. This is what I found out.. seems a bit overkill but it does do the job..

VB Code:

Dim Shp As ShapeRange
  Dim IShp As Shape
  Dim i As Integer
  Dim j As Integer
  For i = 1 To ActiveSheet.Shapes.Count
    ActiveSheet.Shapes(1).Select
    Set Shp = Selection.ShapeRange
    For j = 1 To Shp.DiagramNode.Diagram.Nodes.Count
      Set IShp = Shp.DiagramNode.Diagram.Nodes(j).Shape
      On Error Resume Next
      If IShp.Hyperlink.Address <> "" Then
        IShp.Hyperlink.Delete
      End If
      On Error GoTo 0
    Next j
  Next i
End Sub

Not tested on a shape without any subsequent shapes inside, so not sure what will happen, but this should remove the hyperlinks from all organisation charts on the spreadsheet.

its also not working....

bye d way where do u got the code from?

It might not work in the loop try taking it out of the loop and refer to the organization chart explicity..

The code came from my own head.. as always..

Try this one

VB Code:

Dim Shp As ShapeRange
  Dim IShp As Shape
  Dim i As Integer
  ActiveSheet.Shapes("Name of Organization chart here").Select
  Set Shp = Selection.ShapeRange
  For i = 1 To Shp.DiagramNode.Diagram.Nodes.Count
    Set IShp = Shp.DiagramNode.Diagram.Nodes(i).Shape
    On Error Resume Next
    If IShp.Hyperlink.Address <> "" Then
      IShp.Hyperlink.Delete
    End If
    On Error GoTo 0
  Next i

Code:

---

If IShp.Hyperlink.Address <> "" Then
IShp.Hyperlink.Delete

---

method or data member not found....

No one seems to have such problem anytime?

Sorry my bad the error trapping doesn't work all that good.. this sub will remove all hyperlinks, in shapes, orgcharts and cells in the activesheet.

VB Code:

Sub removelinks()
  Dim Shp As ShapeRange
  Dim IShp As Shape
  Dim i As Integer
  Dim j As Integer
  On Error GoTo ResNextShp
  For j = 1 To ActiveSheet.Shapes.Count
    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
    Else
      Set IShp = ActiveSheet.Shapes(j)
      If IShp.Hyperlink.Address <> "" Then IShp.Hyperlink.Delete
    End If
  Next j
  Debug.Print ActiveSheet.Hyperlinks.Count
  i = 0
  For i = ActiveSheet.Hyperlinks.Count To 1 Step -1
    ActiveSheet.Hyperlinks(i).Delete
  Next i
  Exit Sub
  
ResNextShp:
  Resume Next
End Sub

Code:

---

If IShp.Hyperlink.Address <> "" Then
IShp.Hyperlink.Delete

---

method or data member not found

Are you using the exact code that I gave you as it seems to be turning the error trap off..

I have tested this on a spreadsheet with an organisation chart, two objects with a hyperlink, a block arrow again with a hyperlink and then to cells in the file with hyperlinks... post the exact code you are using..

[code]

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:\Book1.xls")
objexcel.WindowState = xlMinimized
objexcel.WindowState = xlMaximized


Dim Shp As ShapeRange
Dim IShp As Shape
Dim i As Integer
Dim j As Integer
On Error GoTo ResNextShp
For j = 1 To ActiveSheet.Shapes.Count
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
Else
Set IShp = ActiveSheet.Shapes(j)
If IShp.Hyperlink.Address <> "" Then IShp.Hyperlink.Delete
End If
Next j
Debug.Print ActiveSheet.Hyperlinks.Count
i = 0
For i = ActiveSheet.Hyperlinks.Count To 1 Step -1
ActiveSheet.Hyperlinks(i).Delete
Next i
Exit Sub

ResNextShp:
Resume Next

End Sub




[code]

That explains it then.. you are not doing this within Excel, but rather vb6 to excel ??

VB Code:

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:\Book1.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
      Next i
    Else
      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

Hi !
I have tried the code in excel, it is removing all hyperlinks except organization chart.
Which i have already done.

Actually i am creating a activex control in vb which will remove all the links from selected excel sheet except a text link.

I have developed code for this. Only problem is with the organization chart (or u can say graphical objects)

HI !

First of all thanks for being with me...

I have tried this code in vb it's not givin any error and also removing hyperlinks but not from organization chart.

The organization chart works with shape nodes, shapes within an existing shape.. The code will remove hyperlinks from the shapes inside the organization chart, if there is a hyperlink on the organization chart itself then it will be best to include it at the end of the first loop..

Change the If..Else..End If statement so that it will refer to the organization chart as an object straight after removing any links from it's nodes..

VB Code:

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:\Book1.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
      Next i
    End If
    Set IShp = objexcel.ActiveSheet.Shapes(j)
    If IShp.Hyperlink.Address <> "" Then IShp.Hyperlink.Delete
  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

This can also be re-coded to remove from all sheets by inserting a couple more lines as a loop around the worksheets, if you want that as well then let me know.

Hi ! I have used above given code but its not working.
can u just check if its working?

You want me to make any changes in ur code?

Unfotunately I had to leave office early yesterday. I have had a look at the process and it does not remove the link from the Organisation Chart itself, but why would the actual chart have a link anyway? Do the individual names in the chart have the links??

I will have to look into this a bit more as even the recorded macro method does work..

I cannot use vb6 at work, only have .Net and office.

HI ! How was ur yesdy?
I hope it was great.....

not individuals names in org. chart has hyperlinks. But the lines inside org. chart has links. ALso links are there on a org. chart itself.

have a good day!

ActiveSheet.Hyperlinks.Count always returns ZERO for me in Excel '97 and 2003. There are TWO working hyperlinks on the sheet. You might start a new thread asking how to detect hyperlinks.

This might help:

Code:

---

Sub Macro1()
' Select a cell and run this macro
' If more than one cell is selected, only the upper left cell is tested
Dim i As Integer

    i = InStr(Selection.Formula, "HYPERLINK")
    If i > 0 Then MsgBox "This is probably a HYPERLINK cell"
End Sub

---

I dont want to remove text hyperlinks :

can u just modify this code?

VB Code:

Dim nolinks As Integer
  nolinks = 0
  Dim Shp As Excel.ShapeRange
  Dim IShp As Excel.Shape
  Dim i As Integer
  Dim j As Integer
  On Error GoTo ResNextShp
  If wSheet.Hyperlinks.Count = 0 Then
     nolinks = nolinks + 1
  Else
                  
        
  For j = 1 To AppExcel.ActiveSheet.Shapes.Count
    AppExcel.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
        hashyperlinks = True
        End If
      Next i
    End If
    Set IShp = AppExcel.ActiveSheet.Shapes(j)
    If IShp.Hyperlink.Address <> "" Then
    IShp.Hyperlink.Delete
    hashyperlinks = True
    'End If
    End If
  Next j
  
 
  i = 0
  For i = AppExcel.ActiveSheet.Hyperlinks.Count To 1 Step -1
    AppExcel.ActiveSheet.Hyperlinks(i).Delete
    hashyperlinks = True
 
  Next i
 
 
'End If
ResNextShp:
  Resume Next

"Re: remove hyperlinks"
"I am trying to remove hyperlink from excel sheet."

"I dont want to remove text hyperlinks :"

???? Make up your mind please.

"can u just modify this code?"

No

My Comment:

Quote:

---

Originally Posted by Webtest

ActiveSheet.Hyperlinks.Count always returns ZERO for me in Excel '97 and 2003.

---

Your Code:

Code:

---

  For i = AppExcel.ActiveSheet.Hyperlinks.Count To 1 Step -1
    AppExcel.ActiveSheet.Hyperlinks(i).Delete
    hashyperlinks = True
  Next i

---

Art,

the code is mine.. v_gyku wants all hyperlinks removing from the sheet, this includes those inside cells, those on shapes and also those on diagrams.

the code I gave him did this, however it would not remove the links on an organization chart itself.

I can't find a way easily to do this, and at present I do not have the time to go back to this.

I will come back with other solutions as and when my current workload eases up.

Danny ...

You have more patience and time than I do. He ought to break out the smallest piece of code that doesn't work. I just don't have time to scrounge through a bunch of uncommented code looking for subtle operational problems.

I don't think the piece of code I highlighted in my last post will work. (???)

Must be the way you have placed the hyperlinks into the cells as it works fine on my Excel XP version.

Here is the formula in cell F10. It displays as a blue underlined link:

=HYPERLINK("http://www.yahoo.com")

Code:

---

Sub Macro1()
MsgBox ActiveSheet.Hyperlinks.Count
End Sub

---

Reports "0" in Excel '97
Reports "0" in Excel 2003

Clicking on the link on the sheet also brings up Yahoo in a browser window.

I've shown you mine ... now you show me yours!

Tools Menu...

Insert Hyperlink.. This counts as a hyperlink and not a formula..

or quite simply...

Type www.vbforums.com when on a cell. it changes to underlined text and is included in the hyperlinks count..

Now type the following into the immediate window and notice that 1 is returned

?activesheet.hyperlinks.count

This was done in excel 2003.

Ahhh ... So there are TWO different kinds of Hyperlinks!