[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]
[color=darkblue]Sub[/color] GetText()
[color=darkblue]Dim[/color] wksDest [color=darkblue]As[/color] Worksheet
[color=darkblue]Dim[/color] shp [color=darkblue]As[/color] Shape
[color=darkblue]Dim[/color] ShpCount [color=darkblue]As[/color] [color=darkblue]Long[/color]
[color=darkblue]Dim[/color] r [color=darkblue]As[/color] [color=darkblue]Long[/color]
[color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]Resume[/color] [color=darkblue]Next[/color]
ShpCount = Selection.ShapeRange.Count
[color=darkblue]If[/color] Err.Number <> 0 [color=darkblue]Then[/color]
MsgBox "No shapes have been selected...", vbExclamation
[color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
[color=darkblue]End[/color] [color=darkblue]If[/color]
[color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] 0
Application.ScreenUpdating = [color=darkblue]False[/color]
[color=green]'Change the destination sheet accordingly[/color]
[color=darkblue]Set[/color] wksDest = Worksheets("Sheet2")
[color=darkblue]For[/color] [color=darkblue]Each[/color] shp [color=darkblue]In[/color] Selection.ShapeRange
[color=darkblue]With[/color] wksDest
r = r + 1
.Cells(r, "A").Value = shp.Name
.Cells(r, "B").Value = shp.TextFrame.Characters.Text
[color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]Next[/color] shp
wksDest.Columns("A:B").AutoFit
Application.ScreenUpdating = [color=darkblue]True[/color]
MsgBox "Text from " & ShpCount & " shapes have been extracted...", vbInformation
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
[/font]
Maybe something like this... Select the desired shapes from the worksheet, then run the following macro. For each selected shape, the macro places the name of the shape in Column A and the corresponding text in Column B in Sheet2 (change as desired in the code)...
Code:[FONT=Verdana][COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR][/FONT] [FONT=Verdana][COLOR=darkblue]Sub[/COLOR] GetText()[/FONT] [FONT=Verdana] [COLOR=darkblue]Dim[/COLOR] wksDest [COLOR=darkblue]As[/COLOR] Worksheet[/FONT] [FONT=Verdana] [COLOR=darkblue]Dim[/COLOR] shp [COLOR=darkblue]As[/COLOR] Shape[/FONT] [FONT=Verdana] [COLOR=darkblue]Dim[/COLOR] ShpCount [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR][/FONT] [FONT=Verdana] [COLOR=darkblue]Dim[/COLOR] r [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR][/FONT] [FONT=Verdana] [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR][/FONT] [FONT=Verdana] ShpCount = Selection.ShapeRange.Count[/FONT] [FONT=Verdana] [COLOR=darkblue]If[/COLOR] Err.Number <> 0 [COLOR=darkblue]Then[/COLOR][/FONT] [FONT=Verdana] MsgBox "No shapes have been selected...", vbExclamation[/FONT] [FONT=Verdana] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR][/FONT] [FONT=Verdana] [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR][/FONT] [FONT=Verdana] [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0[/FONT] [FONT=Verdana] Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR][/FONT] [FONT=Verdana] [COLOR=green]'Change the destination sheet accordingly[/COLOR][/FONT] [FONT=Verdana] [COLOR=darkblue]Set[/COLOR] wksDest = Worksheets("Sheet2")[/FONT] [FONT=Verdana] [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] shp [COLOR=darkblue]In[/COLOR] Selection.ShapeRange[/FONT] [FONT=Verdana] [COLOR=darkblue]With[/COLOR] wksDest[/FONT] [FONT=Verdana] r = r + 1[/FONT] [FONT=Verdana] .Cells(r, "A").Value = shp.Name[/FONT] [FONT=Verdana] .Cells(r, "B").Value = shp.TextFrame.Characters.Text[/FONT] [FONT=Verdana] [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR][/FONT] [FONT=Verdana] [COLOR=darkblue]Next[/COLOR] shp[/FONT] [FONT=Verdana] wksDest.Columns("A:B").AutoFit[/FONT] [FONT=Verdana] Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR][/FONT] [FONT=Verdana] MsgBox "Text from " & ShpCount & " shapes have been extracted...", vbInformation[/FONT] [FONT=Verdana][COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR][/FONT]
You're very welcome! Thanks for the feedback!