Solved: Copy text from shapes

[YasserKhalil]

Hi again
I have three shapes(rectangle 1,rectangle 2,rectangle 3) and there's text on each
I'd like - through vba - to copy the text in range("A1:A3") for example

[GTO]

Seems to work, but I'm sure there must be a more graceful way of doing this... hopefully someone will show it.

Option Explicit
 
Sub exaShapesText()
Dim shp     As Shape
Dim strText As String
 
    For Each shp In Me.Shapes
 
        If shp.AutoShapeType = msoShapeRectangle Then
 
            On Error Resume Next
            strText = shp.TextFrame.Characters.Text
            If Err.Number > 0 Then
                Err.Clear
            Else
                If Len(strText) > 0 Then
                    Cells(Me.Rows.Count, 1).End(xlUp).Offset(1).Value = strText
                End If
            End If
        End If
    Next
End Sub

Mark

Edit: The above would be placed in the worksheet's module. It is just a preliminary example, as I would want to place such a sub in a standard module and reference/qualify the sheet.

[YasserKhalil]

Thanks Mr. Mark
It's great help
But I want to refer to the shape itself like that

strText = Shapes("rectangle 1").TextFrame.Characters.Text
Range("A1").Value = strText

[GTO]

Hi Yasser,

Other than if the rectangle has no text, that should work; so I am afraid I am not seeing the problem?

Mark

[YasserKhalil]

I just want to refer to each shape separately as in the post no. 3 ..Is it clear?? If not I can attach a file
I have written a code but it doesn't work my dear

[GTO]

I think that posting the workbook may well indeed be helpful. Please post in .xls format.

I may be heading out, but will look when I can.

[YasserKhalil]

Here's a file

[YasserKhalil]

Thank you
I found that I have to refer to the activesheet at first like this

Dim strText As String
strText = ActiveSheet.Shapes("Rectangle 1").TextFrame.Characters.Text
Range("A1") = strText