Capturing Shape Name/Text from OnAction property

How can I capture (assign) the text content of a shape
(rectangle)into a procedure using the OnAction property
for the shape?
I have many shapes (rectangles) on a worksheet, each of
which is named. When a shape is clicked, I need to assign
the 'Characters.Text' content of that shape to a variable
in the procedure called by the OnAction property. I am
trying to create a usable 'generic' procedure rather than
having a separate procedure for each shape.

William,

Do you have a separate procedure for each shape,
or does each shape call the same procedure.

Regards,
Jim Cone
San Francisco, USA


"William Bartusek" <[email protected]> wrote in message
news:[email protected]...
> How can I capture (assign) the text content of a shape
> (rectangle)into a procedure using the OnAction property
> for the shape?
> I have many shapes (rectangles) on a worksheet, each of
> which is named. When a shape is clicked, I need to assign
> the 'Characters.Text' content of that shape to a variable
> in the procedure called by the OnAction property. I am
> trying to create a usable 'generic' procedure rather than
> having a separate procedure for each shape.
>

I want to create a common procedure that captures the
shape name that is clicked (OnAction), then places
(assigns) the name to a variable in the called procedure.
Right now I have accomplished this by having a separate
procedure for each shape. See comment below.

Private Sub Test()
Dim txt As String, c As Range, rng As Range, rw As Long, r
As Long, ufrm As Object

Worksheets("SERVICE MEASURES-Strategy").Unprotect

Worksheets("SERVICE MEASURES-Strategy").Shapes
("SvcOA_Age").Select 'this is the shape name that
is 'clicked'
'I want the "OnAction" clicked shape "Character.Text" to
be captured in a variable in the called procedure rather
than the pre-coded name "SvcOA_Age" (or whatever the
Character.Text of the shape) so that I don't need a
separate procedure for each shape.

txt = Selection.Characters.Text
'activate the worksheet and named range
Worksheets("STRATEGY GUIDANCE").Activate
Worksheets("STRATEGY GUIDANCE").Range
("STRATEGY_GUID").Activate
rw = Worksheets("STRATEGY GUIDANCE").Range
("STRATEGY_GUID").Rows.Count
'find the Shapes.Text in column 1 of the STRATEGY_GUID
named range
With Worksheets("STRATEGY GUIDANCE").Range
("STRATEGY_GUID").Columns(1)
Set rng = .Find(txt, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, MatchCase:=True)
If Not rng Is Nothing Then
r = rng.Rows.Row

Set ufrm = SvcMeasure
With ufrm
.LblSvcMeasure = Worksheets("STRATEGY GUIDANCE").Range
("B" & r)
.Guidance.Value = Worksheets("STRATEGY GUIDANCE").Range
("C" & r)
.Strategy.Value = Worksheets("STRATEGY GUIDANCE").Range
("D" & r)
.Locate = r
.Show
End With
End If
End With

Worksheets("STRATEGY GUIDANCE").Range("A1").Activate
Worksheets("SERVICE MEASURES-Strategy").Activate
Worksheets("SERVICE MEASURES-Strategy").Protect

End Sub
>-----Original Message-----
>William,
>
>Do you have a separate procedure for each shape,
>or does each shape call the same procedure.
>
>Regards,
>Jim Cone
>San Francisco, USA
>
>
>"William Bartusek" <[email protected]>
wrote in message
>news:[email protected]...
>> How can I capture (assign) the text content of a
shape
>> (rectangle)into a procedure using the OnAction property
>> for the shape?
>> I have many shapes (rectangles) on a worksheet, each
of
>> which is named. When a shape is clicked, I need to
assign
>> the 'Characters.Text' content of that shape to a
variable
>> in the procedure called by the OnAction property. I am
>> trying to create a usable 'generic' procedure rather
than
>> having a separate procedure for each shape.
>>
>.
>

William,

Assign the "DoThemAll" sub to each shape.
'DoThemAll' determines the text in the shape and then
passes that text in a variable to your main procedure (Test)...
'---------------------------------
Sub DoThemAll()
Dim strName As String
Dim strText As String
strName = Application.Caller
strText = ActiveSheet.Shapes(strName).TextFrame.Characters.Text
'Call the main procedure, passing strText to it
Test strText
End Sub

Private Sub Test(ByRef txt As String)
Dim c As Range
Dim rng As Range
Dim rw As Long
Dim r As Long
Dim ufrm As Object

'Your code
MsgBox txt
End Sub
'---------------------------------

Regards,
Jim Cone
San Francisco, USA



"William Bartusek" <[email protected]> wrote in
message news:[email protected]...
> I want to create a common procedure that captures the
> shape name that is clicked (OnAction), then places
> (assigns) the name to a variable in the called procedure.
> Right now I have accomplished this by having a separate
> procedure for each shape. See comment below.
>
> Private Sub Test()
> Dim txt As String, c As Range, rng As Range, rw As Long, r
> As Long, ufrm As Object
>
> Worksheets("SERVICE MEASURES-Strategy").Unprotect
>
> Worksheets("SERVICE MEASURES-Strategy").Shapes
> ("SvcOA_Age").Select 'this is the shape name that
> is 'clicked'
> 'I want the "OnAction" clicked shape "Character.Text" to
> be captured in a variable in the called procedure rather
> than the pre-coded name "SvcOA_Age" (or whatever the
> Character.Text of the shape) so that I don't need a
> separate procedure for each shape.
>
> txt = Selection.Characters.Text
> 'activate the worksheet and named range
> Worksheets("STRATEGY GUIDANCE").Activate
> Worksheets("STRATEGY GUIDANCE").Range
> ("STRATEGY_GUID").Activate
> rw = Worksheets("STRATEGY GUIDANCE").Range
> ("STRATEGY_GUID").Rows.Count
> 'find the Shapes.Text in column 1 of the STRATEGY_GUID
> named range
> With Worksheets("STRATEGY GUIDANCE").Range
> ("STRATEGY_GUID").Columns(1)
> Set rng = .Find(txt, LookIn:=xlValues, LookAt:=xlWhole, _
> SearchOrder:=xlByColumns, MatchCase:=True)
> If Not rng Is Nothing Then
> r = rng.Rows.Row
>
> Set ufrm = SvcMeasure
> With ufrm
> .LblSvcMeasure = Worksheets("STRATEGY GUIDANCE").Range
> ("B" & r)
> .Guidance.Value = Worksheets("STRATEGY GUIDANCE").Range
> ("C" & r)
> .Strategy.Value = Worksheets("STRATEGY GUIDANCE").Range
> ("D" & r)
> .Locate = r
> .Show
> End With
> End If
> End With
>
> Worksheets("STRATEGY GUIDANCE").Range("A1").Activate
> Worksheets("SERVICE MEASURES-Strategy").Activate
> Worksheets("SERVICE MEASURES-Strategy").Protect
>
> End Sub
> >-----Original Message-----
> >William,
> >
> >Do you have a separate procedure for each shape,
> >or does each shape call the same procedure.
> >
> >Regards,
> >Jim Cone
> >San Francisco, USA