VBA to loop through all shapes on ActiveSheet and iterate their shape name by appending +1

[shella]

I'd like to iterate through all shapes on an ActiveSheet (of which each shape is comprised of 3 named parts - "Background_COLORNAME", "Title_COLORNAME", and Text_COLORNAME") to rename shapes with the same exact name by appending # that iterates by (1) for each existing shape ex:

"Title_Yellow1"
"Title_Yellow2"
"Title_Yellow3"
"Text_Yellow1"
"Text_Yellow2" etc.

The goal for renaming is to then be able to run a VBA that loops through all shapes, now individually named, and copies their text to a table for further analysis. As it stands, if the shapes have the same exact name, the VBA only pulls the text from the "original" shape.

I can't seem to find a similar macro request that I could use as a starting point and modify, so I'm really looking for any help/guidance/suggestions. Thanks in advance!

 

[yky]

If you can loop through all shapes, you can pull the text from all shapes. I don't understand why you need to rename first.

What is the VBA code you are using now?

What is the name of the shapes? You said the name comprises three parts but the examples you gave only have one part.

The following code loops through all shapes in the activesheet and displays their name.

Sub shapes()

Dim shp As Shape

For Each shp In ActiveSheet.shapes

MsgBox (shp.name)

Next

End Sub

 

[shella]

<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px 'Helvetica Neue'; color: #454545}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px 'Helvetica Neue'; color: #454545; min-height: 14.0px}</style>

If you can loop through all shapes, you can pull the text from all shapes. I don't understand why you need to rename first.


--- Oh even better!! If you can help point me in the right direction that would be wonderful! ---


What is the VBA code you are using now?


--- I don't have any code to rename the shapes, as I wasn't sure where to start with the looping piece. The code that I was using to export the data to a table was a basic:

[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]Sub ExporttoTable()[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]
[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]With ActiveSheet[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff].Range("AD1").End(xlDown).Offset(1, 0).Value = .Shapes("Title").TextFrame.Characters.Text[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff].Range("AD1").End(xlDown).Offset(1, 0).Value = .Shapes("Title_1").TextFrame.Characters.Text[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff].Range("AD1").End(xlDown).Offset(1, 0).Value = .Shapes("Title_2").TextFrame.Characters.Text[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff].Range("AD1").End(xlDown).Offset(1, 0).Value = .Shapes("Title_3").TextFrame.Characters.Text[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff].Range("AE1").End(xlDown).Offset(1, 0).Value = .Shapes("Text").TextFrame.Characters.Text[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff].Range("AE1").End(xlDown).Offset(1, 0).Value = .Shapes("Text_1").TextFrame.Characters.Text[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff].Range("AE1").End(xlDown).Offset(1, 0).Value = .Shapes("Text_2").TextFrame.Characters.Text[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff].Range("AE1").End(xlDown).Offset(1, 0).Value = .Shapes("Text_3").TextFrame.Characters.Text[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]
[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]End With[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]End Sub[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]

What is the name of the shapes? You said the name comprises three parts but the examples you gave only have one part.


----Sorry for the confusion - the shape is a "post-it" that contains a background square ("Background"), title bar ("Title") and text box ("Text"). The reason they all end up with the exact same name is the VBA used to generate the post-its. I currently have it set-up where the shape is already built and named according to the style above, with the original "template" hidden. The VBA to create a new one based on that color (as I have a button for 9 different post-it color options) is:

[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]Sub postit_yellow()[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]Application.ScreenUpdating = False[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]ActiveSheet.Shapes.Range(Array("YellowPostIt")).Visible = True[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]    ActiveSheet.Shapes.Range(Array("YellowPostIt")).Select[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]    Selection.Copy[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]    ActiveSheet.Paste[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]ActiveSheet.Shapes.Range(Array("YellowPostIt")).Visible = False[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]Application.ScreenUpdating = True[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]End Sub[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]

or this one for a blue post-it:

[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]Sub postit_blue()[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]'Application.ScreenUpdating = False[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]ActiveSheet.Shapes.Range(Array("BluePostIt")).Visible = True[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]    ActiveSheet.Shapes.Range(Array("BluePostIt")).Select[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]    Selection.Copy[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]    ActiveSheet.Paste[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]ActiveSheet.Shapes.Range(Array("BluePostIt")).Visible = False[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]Application.ScreenUpdating = True[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]End Sub[/COLOR]
[COLOR=#0000ff][/COLOR][COLOR=#0000ff]

This causes every generation of a post-it to create a shape with the exact same named pieces ("Background", "Text", "Title"). When I then run the basic export to table code above, it only grabs the first one and leaves out all subsequent post-its. Even if I change the original template for each colored post-it to say "Background_Yellow, Text_Yellow, Title_Yellow" and the same for blue, green, etc. It only grabs the first one of each of the post-it copies (so 9 total possible) leaving all other post-its out of the table. This is why I thought perhaps a VBA to loop through and rename by appending an iterating number (Ex. "_1, _2") might solve the problem.


There is probably a MUCH better way to approach this than what I have set-up thus far. At the end of the day, what I'm trying to do is have one-click buttons (of various colors) that allow the user to generate a pre-colored/formatted post-it in that color for a brainstorming activity. A use case could result in having 60 yellow, 30 blue, 4 green, and 19 pink post-its. I then want to export all of the data on all of the post-its created by the user (not the original hidden templates) to a table that captures: post-it color ("Background"), post-it title ("Title"), and post-it text ("Text"). Any ideas?


Your code below is perfect for finding out the name of each shape, as you suggested. But I actually don't need to find out the name (and I don't want to pull in the invisible post-it "templates" that are used to generate the user post-its. I just want to be able to export the user-generated post-its and their content.


Thanks in advance!!




The following code loops through all shapes in the activesheet and displays their name.

Sub shapes()


Dim shp As Shape


For Each shp In ActiveSheet.shapes


MsgBox (shp.name)


Next


End Sub

 

[yky]

Try this:

Sub exportT()
Dim shp As Shape

For Each shp In ActiveSheet.Shapes

If InStr(shp.Name, "Title") <> 0 Then
ActiveSheet.Range("AD1").End(xlDown).Offset(1, 0).Value = shp.TextFrame.Characters.Text
ElseIf InStr(shp.Name, "Text") <> 0 Then
ActiveSheet.Range("AE1").End(xlDown).Offset(1, 0).Value = shp.TextFrame.Characters.Text
Else
MsgBox ("shape name out of range.")
End If

Next shp

End Sub

 

[shella]

YKY,

Thanks for your response - unfortunately it was a no-go. From the research I've done, apparently Excel falls apart when attempting to extract text from a grouped (set of) shapes. If anyone has found a workaround that will allow extraction of text from the separate parts, without ungrouping/regrouping the shape...that would be wonderful!

Thanks!