Autoshapes

  • Thread starter Thread starter Scoop
  • Start date Start date
S

Scoop

Hello all. Can anyone help - I have an Excel sheet with around 500 Shapes,
and a second sheet with 3000 rows of text. The first column of the text
contains the ShapeName. I have a simple autofilter macro (
Selection.AutoFilter Field:=1, Criteria1:=" M162" ) where Criteria 1 IS the
ShapeName. I want to assign my macro to the whole worksheet so as whichever
shape I click on then the Criteria1 of the Macro detects the ShapeName. I do
not want to assign a separate macro for each shape. I think it might be
something to do with ... ActiveSheet.Shapes(Application.Caller).Select, but
I'm really quite lost. Any help would be fantastic.
 
Maybe something like:

Option Explicit
Sub DoFilter()
Dim myShape As Shape

Set myShape = ActiveSheet.Shapes(Application.Caller)

'MsgBox myShape.Name 'just for testing
Worksheets("Sheet2").UsedRange.AutoFilter _
Field:=1, Criteria1:=" " & myShape.Name

End Sub
Sub RunMeOnce()
Dim myShape As Shape
For Each myShape In Worksheets("Sheet1").Shapes
myShape.OnAction = "'" & ThisWorkbook.Name & "'!DoFilter"
Next myShape
End Sub

I included an extra space in the filter criterial. I'm not sure if that was on
purpose or a typo in the post.
 
500 shapes.. Is it possible that a double_click event could be used instead.
I have one that goes to the file or sheet that is typed into the cell...
Just a thought.
 
Thanks Dave, that works quite well. Just one thing. Maybe I'm doing something
wrong.

Because all of my shapes are lined up to make a diagram, I have 'grouped'
some together. When I click on a Rectangle, or an Oval it initiates the
filter and works well. When I click on a 'grouped' item, it initiates the
filter, but returns 0 Records, when I know that my sample dataset does have
results. This is the same for all my 'grouped' shapes.

Any ideas

Thanks
 
Hi,

You could use the Before_DoubleClick proceedure, in which case the user
would double click a text entry they want to filter on and it would run your
filter

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target
As Range, Cancel As Boolean)
Cancel = True
If Sh.Name = "Data" Then
If Not Intersect(Target, [A1:A3000]) Is Nothing Then
Selection.AutoFilter Field:=1, Criteria1:=Target
End If
End Sub

If this helps, please click the Yes button

cheers,
Shane Devenshire
 
So you want to use the name of the group, not the name of the object in that
group, right?

Option Explicit
Sub DoFilter()
Dim myName As String
Dim myGroupName As String

myName = Application.Caller

myGroupName = GetGroupName(wks:=ActiveSheet, myShapeName:=myName)

If myGroupName = "" Then
'don't change myname
Else
'use the groupname
myName = myGroupName
End If


'MsgBox myShape.Name 'just for testing
Worksheets("Sheet2").UsedRange.AutoFilter _
Field:=1, Criteria1:=" " & Replace(myName, "/", "_")

End Sub
Function GetGroupName(wks As Worksheet, myShapeName As String)

Dim myGroup As Shape
Dim i As Long
Dim FoundIt As Boolean
Dim itemCount As Long
Dim myGroupName As String

FoundIt = False
myGroupName = ""
For Each myGroup In wks.Shapes
itemCount = 0
On Error Resume Next
itemCount = myGroup.GroupItems.Count
On Error GoTo 0
If itemCount > 0 Then
For i = 1 To myGroup.GroupItems.Count
If myGroup.GroupItems(i).Name = Application.Caller Then
myGroupName = myGroup.Name
FoundIt = True
Exit For
End If
Next i
If FoundIt Then
Exit For
End If
Else
If myGroup.Name = Application.Caller Then
myGroupName = "" 'not in a group
End If
End If
Next myGroup

GetGroupName = myGroupName

End Function
Sub RunMeOnce()
Dim myShape As Shape
For Each myShape In Worksheets("Sheet1").Shapes
myShape.OnAction = "'" & ThisWorkbook.Name & "'!DoFilter"
Next myShape
End Sub
 
Some of my shapes have object names, and some when grouped together have a
group name, for example I have Rectangle 1, Oval 5 and I may also have Group
9 (because I needed to bring 2 shapes together as one, hence the default
Group name)

When I have my finished article I may click on a Rectangle, an Oval or a
Group. The code was not working for the Groups. I will now try your amedned
code thanks.

I will also change the default object name individually to something more
useful to me

Thanks again
 
Thanks Shane.

The user has to be able to click the shape, and not a text entry.. cheers


Shane Devenshire said:
Hi,

You could use the Before_DoubleClick proceedure, in which case the user
would double click a text entry they want to filter on and it would run your
filter

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target
As Range, Cancel As Boolean)
Cancel = True
If Sh.Name = "Data" Then
If Not Intersect(Target, [A1:A3000]) Is Nothing Then
Selection.AutoFilter Field:=1, Criteria1:=Target
End If
End Sub

If this helps, please click the Yes button

cheers,
Shane Devenshire

Scoop said:
Hello all. Can anyone help - I have an Excel sheet with around 500 Shapes,
and a second sheet with 3000 rows of text. The first column of the text
contains the ShapeName. I have a simple autofilter macro (
Selection.AutoFilter Field:=1, Criteria1:=" M162" ) where Criteria 1 IS
the
ShapeName. I want to assign my macro to the whole worksheet so as
whichever
shape I click on then the Criteria1 of the Macro detects the ShapeName. I
do
not want to assign a separate macro for each shape. I think it might be
something to do with ... ActiveSheet.Shapes(Application.Caller).Select,
but
I'm really quite lost. Any help would be fantastic.
Click to expand...
Click to expand...
 
Hi Dave,

I wonder.... If I have a list of all my ShapeNames in sheet 1 Column A, is
there a way that when I hover the mouse over the shape, it reveals a box,
showing the text which I have in sheet 1 column B for that shape. A bit like
when you hover the mouse over a Hyprlink you can see descriptive text

A system seems to be widely used on the internet web pages where you see
certain words underlined or in italics, if you hover th mouse it shows an
explanation of the word..

Thanks
 
You could assign a hyperlink to that shape, but I don't think that this would
work for you.

If your shapes are nicely spaced, maybe you could add a comment to the cell that
holds the shape. You'll see that comment when you hover over the cell (but not
over the shape).


Hi Dave,

I wonder.... If I have a list of all my ShapeNames in sheet 1 Column A, is
there a way that when I hover the mouse over the shape, it reveals a box,
showing the text which I have in sheet 1 column B for that shape. A bit like
when you hover the mouse over a Hyprlink you can see descriptive text

A system seems to be widely used on the internet web pages where you see
certain words underlined or in italics, if you hover th mouse it shows an
explanation of the word..

Thanks
Click to expand...
 
Why?

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
Scoop said:
Thanks Shane.

The user has to be able to click the shape, and not a text entry.. cheers


Shane Devenshire said:
Hi,

You could use the Before_DoubleClick proceedure, in which case the user
would double click a text entry they want to filter on and it would run
your
filter

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal
Target
As Range, Cancel As Boolean)
Cancel = True
If Sh.Name = "Data" Then
If Not Intersect(Target, [A1:A3000]) Is Nothing Then
Selection.AutoFilter Field:=1, Criteria1:=Target
End If
End Sub

If this helps, please click the Yes button

cheers,
Shane Devenshire

Scoop said:
Hello all. Can anyone help - I have an Excel sheet with around 500
Shapes,
and a second sheet with 3000 rows of text. The first column of the text
contains the ShapeName. I have a simple autofilter macro (
Selection.AutoFilter Field:=1, Criteria1:=" M162" ) where Criteria 1 IS
the
ShapeName. I want to assign my macro to the whole worksheet so as
whichever
shape I click on then the Criteria1 of the Macro detects the ShapeName.
I
do
not want to assign a separate macro for each shape. I think it might be
something to do with ... ActiveSheet.Shapes(Application.Caller).Select,
but
I'm really quite lost. Any help would be fantastic.
Click to expand...
Click to expand...
Click to expand...
 
Good idea Dave, but unfortunately I have some shapes which are, and need to
be, very small and close together with several in each cell. You are correct
that the Hyperlink method basis doesnt do it.

Ay other thoughts? I'll keep thinking.
Cheers
 
I don't think it's possible--well, it's not possible for me.

Maybe someone else will chime in.
Good idea Dave, but unfortunately I have some shapes which are, and need to
be, very small and close together with several in each cell. You are correct
that the Hyperlink method basis doesnt do it.

Ay other thoughts? I'll keep thinking.
Cheers
Click to expand...
 
When I tried that, clicking on the object didn't run the macro. It followed the
hyperlink.

I used xl2003 for my tests.

And the before_hyperlink event didn't fire for me, for those hyperlinks assigned
to shapes. So I couldn't use that, either.

Bob said:
Use the "hyperlink trick" and put your Comment in the "Screen Tip"
Click to expand...
 
Yes, it appears to take control before the Macro link. and Alt text
doesn't work because a browser isn't involved either.
 
Back
Top