Copy shape text from active shape

Question

I am trying to create a macro that states, copy the text from the active shape and paste the text in the next available cell in column B.

The macro below copies it from a specific shape and pastes it into a specific cell, but I need to copy the text from the active. 

(I am using the shape as a button)

Sub Macro2()

'

' Macro1 Macro

Dim strText As String

strText = ActiveSheet.Shapes("Rounded Rectangle 12").TextFrame.Characters.Text

Range("e23") = strText

End Sub

Answer 1

Going back to your original question you say  **"(I am using the shape as a button)".**Does this mean that you have a macro assigned to the Click event of the shape. If so, then when you click the shape it does not select but it does run the assigned code.

If above assumption is correct then you can assign as many shapes as you like to the same macro code and identify the shape that was clicked with Application.Caller.

If you want to show the shape as selected with the handles then use code within the called sub as per my example below with the Optional code line.

Sub Shape_Click()

    Dim strText As String

    Dim shp As Shape

    'Assign the clicked shape to a variable

    Set shp = ActiveSheet.Shapes(Application.Caller)

    shp.Select  'Optional line of code to display the shape with the handles.

    strText = shp.TextFrame.Characters.Text

    Range("e23") = strText

End Sub

Answer 2

I realize that when I click on the shape, the last cell that I clicked on is still selected within Excel. I assume that this is the reason. Not sure how to fix/work around this but, I'll keep trying.

Answer 3

Code worked for me.

If you had a shape selected you should see the handles.

Gord

Answer 4

I tried this however, i got the message that this is not a shape. However, it is. 

It's reference is: Rounded Rectangle 27

Answer 5

Try the following.

Sub Macro2()

    Dim strText As String

    Dim varSelection As Variant

    Dim shp As Shape

    'Assign the current selection to a variable

    Set varSelection = ActiveWindow.Selection

    'Test if the variable object is a shape

    On Error Resume Next

    Set shp = ActiveSheet.Shapes(varSelection.Name)

    On Error GoTo 0

    If Not shp Is Nothing Then  'Not nothing then is something

        strText = shp.TextFrame.Characters.Text

        Range("e23") = strText

    Else

        MsgBox "Current selection is not a shape"

    End If

End Sub