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.T ext
'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" wrote in
message ...
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
|