excel2003 AutoShapes

[nodari]

in my VBA code I need to get texts from the spapes selected by user. it's easy, if it's selected only 1 shape, but if selected 2 or more, I have problem.

can anyone advice me anything?

 

[Domenic]

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)...

[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]

 

[nodari]

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)...

[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]

thank you very much, I found in this code what I needed.

 

[Domenic]

You're very welcome! Thanks for the feedback!

 

[nodari]

You're very welcome! Thanks for the feedback!