Copy/Paste Shapes or Group of Shapes

[joebbshop]

Hello!

I'm using Excel 2007 and have mid level skills with VBA. I'm trying to make a flow-chart type of report with text boxes and arrows connecting them using VBA. Since there are several pieces of data for each point on the flow chart, I'm thinking the best way is to have a series of grouped text box shapes for each point. Since I'd like the report to be standardized, I set up a template set of text boxes.

I'd like to be able to copy/paste this template grouping of text boxes for each point on the flowchart, then rename and relabel each text box. I think I know how to do the renaming/relabeling, but I can't figure out how to copy the grouping and paste it. Eventually, I'll need to move it around on the sheet... I don't know if there's anything special to moving a grouping around vs. a single shape object.

I suppose another option would be to create individual text boxes for each bit of data and each data point on the flow chart, but that seemed less efficient somehow.

Any advice would be appreciated!

~ Alex Brandt.

 

[MickG]

Hi, This is xl2003. If the text Boxes are "ActiveX" (Control ToolBar Menu), then you can Select them as a Group by Holding down "Ctrl", and with the Text Boxes in Design Mode selecting them individually to form a group. You can then Copy them or move them as that group.
Regards Mick

 

[joebbshop]

Oops... I meant to ask for help on how to copy/paste the shape using VBA. I'll have an unknown number of these boxes and I want to create and place them at run time.

Thanks.

 

[MickG]

Hi, I should Group/Move/Copy the TextBoxes, while Running the Macro recorder. This will give you a lot of information.
Mick

 

[VoG]

Unfortunately the macro recorder in Excel 2007 is pretty unhelpful when it comes to operations on shapes (it doesn't record much if anything).

Here's an example of grouping and moving two text boxes:

Sub test()
Dim sr As ShapeRange
Set sr = ActiveSheet.Shapes.Range((Array("TextBox 1", "TextBox 2")))
sr.Group
With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
    .Top = Range("D10").Top
    .Left = Range("D10").Left
End With
End Sub

 

[hilyete]

If you're copying textboxes you have already created (I assume with the same text and attributes) The namea will be "TextBox #" with successive numbers and the numbering becomes difficult to work with in the code, especially if you generate many of these. You probably need to include in your code to rename the boxes to something that you can then refer to in your code. Here is an example that creates a textbox, copies it twice and renames it, then groups them and names the group, then positions them as a group on the page. You may be able to use ideas from it to work out what you're trying to do. The code that creates the first box with all its attributes can be removed if you don't need to create it on the fly.

Sub MakeBoxGroup()
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _
       Top:=Cells(3, 2).Top, Left:=Cells(3, 2).Left, _
    Width:=30, Height:=30).Select
    Selection.Characters.Text = "Hello"
        Selection.Name = "MyBox1"
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With ActiveSheet.Shapes("MyBox1")
        .Copy
        .Name = "MyBox2"
            ActiveSheet.Paste
        .Copy
        .Name = "MyBox3"
            ActiveSheet.Paste
    End With
    
    With ActiveSheet.Shapes("Mybox1")
        .Top = Cells(3, 2).Top
        .Left = Cells(3, 2).Left
    End With
    
    With ActiveSheet.Shapes("Mybox2")
        .Top = Cells(3, 4).Top
        .Left = Cells(3, 4).Left
    End With
    
    With ActiveSheet.Shapes("Mybox3")
        .Top = Cells(3, 6).Top
        .Left = Cells(3, 6).Left
    End With
  
  With ActiveSheet.Shapes.Range(Array("MyBox1", "MyBox2", "MyBox3"))
    .Group
    .Name = "MyGroup1"
  End With
 
 With ActiveSheet.Shapes("MyGroup1")
    
  .Top = Cells(4, 4).Top
  .Left = Cells(4, 4).Left
End With

End Sub

 

[joebbshop]

Great, thanks folks. I'll give these ideas a shot and let you know how things turn out.