get selection text help

can someone help me with this? i want the macro to get the text at the selected shape. this is obviously not working. thanks.

Sub getselectiontext()
ActiveDocument.Pages(pagenum).ActiveLayer.Activate
ActivePage.SelectShapesAtPoint(2.3, 9.88, True).CreateSelection
Set shRange = ActiveSelectionRange
MsgBox shRange.Shapes.Count

For Each stext In shRange.FindShapes(Type:=cdrTextShape)
Set tr = stext.Text.Story.Duplicate
MsgBox tr

Next stext


' If s.Type = cdrTextShape Then s.Text.Story = "New Text": Stop

End Sub

[shelbym]

Give this a try:

Sub getselectiontext()
    Dim tr As New ShapeRange, sText As Shape, sel As Shape
    
    ActiveDocument.ShapeEnumDirection = cdrShapeEnumBottomFirst
    Set sel = ActivePage.SelectShapesAtPoint(2.3, 9.88, True)
    
    For Each sText In sel.Shapes.FindShapes(Type:=cdrTextShape)
        tr.Add sText.Duplicate
    Next sText
End Sub

Best of luck,
-Shelby

Originally Posted by shelbym

Give this a try:

Sub getselectiontext()
    Dim tr As New ShapeRange, sText As Shape, sel As Shape
    
    ActiveDocument.ShapeEnumDirection = cdrShapeEnumBottomFirst
    Set sel = ActivePage.SelectShapesAtPoint(2.3, 9.88, True)
    
    For Each sText In sel.Shapes.FindShapes(Type:=cdrTextShape)
        tr.Add sText.Duplicate
    Next sText
End Sub

Best of luck,
-Shelby

awesome! thanks!!! do you know why the for next loops has to run through 3 times? it's ok if it does. just wondering.

[shelbym]

Because it is finding each text object then duplicating them. You could do it like this and avoid the loop altogether.

Sub getselectiontext()
    Dim tr As New ShapeRange, sText As Shape, sel As Shape
    
    ActiveDocument.ShapeEnumDirection = cdrShapeEnumBottomFirst
    Set sel = ActivePage.SelectShapesAtPoint(2.3, 9.88, True)
    
    sel.Shapes.FindShapes(Type:=cdrTextShape).Duplicate
End Sub

Best of luck,

-Shelby

Shelby,
Thanks again! =D