Shape/Hyperlink script 1

[wilmargrp]

working in Excel 2007 and looking for a script to cycle through all of the Shapes on an ActiveSheet to see if any of them have a Hyperlink attached.

 

[SkipVought]

Hi,

Try this...

Sub WhatShapez()
    Dim hl As Hyperlink
    For Each hl In ActiveSheet.Hyperlinks
        With hl
            If Not .Shape Is Nothing Then
                MsgBox .Shape.Name
            End If
        End With
    Next
End Sub

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[wilmargrp]

Skip the Sub gives me a '1004' error and hangs on

If Not .Shape Is Nothing Then

 

[SkipVought]

I should have tested it with hylerlinks other than shapes.

Sub WhatShapez()
    Dim hl As Hyperlink
    For Each hl In ActiveSheet.Hyperlinks
        With hl
            On Error Resume Next
            If Not .Shape Is Nothing Then
                MsgBox .Shape.Name
            End If
            On Error GoTo 0
        End With
    Next
End Sub

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[wilmargrp]

trying to do a couple different things here. first i'd like to delete any hyperlinks i don't need. i'm using the following to do that but when run it bombs Excel.

any ideas? try to resolve one at a time.

For Each hl In ActiveSheet.Hyperlinks

With hl
If .Type = 0 Then
hl.Delete
End If
End With
Next

 

[SkipVought]

Do you have macros enabled?

Runs fine in 2003 and should in 2007.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[wilmargrp]

yes, actually can't even access VBA in 2007 without enabling macros. don't have a 2003 machine to ck it against. forces excel to shut down and restart??

 

[combo]

What is the error message? Is ActiveSheet unprotected?

combo

 

[wilmargrp]

Thanks to everyone! Between the posts here and the rest of the forum I figured it out. Here are the SUBs. Obviously a bunch more to the module a s well. If anyone has suggestions for the rookie coder on tightening up the code please le me know.
__________________________________
Sub PullEmail()
On Error Resume Next
Dim hl As Hyperlink
For Each hl In ActiveSheet.Hyperlinks
With hl
If Not .Shape Is Nothing Then
Range(.Shape.BottomRightCell.Address).Value = hl.Name
End If
End With
Next
End Sub
________________________________________
Sub RemoveShapes()
Dim TS As Worksheet

Set TS = ActiveSheet

TS.Shapes.SelectAll
Selection.Delete

End Sub
_____________________________________
Sub RemoveLinks()
Dim TS As Worksheet

Set TS = ActiveSheet

TS.Hyperlinks.Delete

End Sub
_______________________________________

Sub RemoveOLEObjects()

On Error Resume Next

ActiveSheet.OLEObjects.Delete

End Sub

 

[SkipVought]

We were all rookies at one time.

Do not set an object, just to use it ONE TIME. It makes no sense.

Sub RemoveShapes(ws As Worksheet)
    ws.Shapes.Delete
End Sub

Also using the Select and Activate methods is unnecessary and counter-productive.

Also, I would make a procedure like this to be used ofr ANY sheet, by passing an argument and then calling...

  RemoveShapes YourSheetObject

In the VB Editor, use Edit > Find...Search CURRENT PROJECT to determine where procedures/variables are located in your PROJECT.

You can PRINT the code in the PROJECT, so you can see where all of it is, if you're not sure.

FYI, when you SET an object, you ought to finally Set that object to NOTHING at the end of your procedure.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}