Grouping Shapes in 2007

B

Brian

I created the following code in Excel 2003 and it works fine.
With Worksheets("Chart")
With .Shapes("Customgrp").Duplicate
.Ungroup
End With
.Shapes("Customdmd").Name = "dmd" & sID
.Shapes("Customlin").Name = "lin" & sID
.Shapes("Customtxt").Name = "txt" & sID
.Shapes("txt" & sID).TextFrame.Characters.Text = ""
.Shapes("lin" & sID).Width = iDur2 * 1.168 - 5
With .Shapes.Range(Array("lin" & sID, "dmd" & sID, "txt"
& sID)).Group
.Name = "grp" & sID
End With
.Shapes("grp" & sID).Visible = True
.Shapes("grp" & sID).Left = lLeft
End With
When I run it in 2007, I get "Error 1004 Group has been disable for Object,"
for the With .Shapes.Range(...) Statement, or something like that. What's
the correct way to group shapes in excel 2007. I don't want to have to
select the object either. Also big picture, what I'm doing is I have a
custom shape that consists of a line a diamond and a text box, I need to
duplicate the custom shape, put something in the text box, and adjust the
width of the line, then put those three shapes back together, name the group,
and then place the group at a particular horizontal location on the
spreadhsheet. So if there's a better way to do it then let me know

Thanks in advance for your help
 
P

Peter T

This is ridiculous but try this

With ActiveSheet
With .Shapes("Customgrp").Duplicate
.Ungroup
End With
.Shapes("Customdmd").Name = "tmpName"
.Shapes("Customdmd").Name = "dmd" & sID
.Shapes("tmpName").Name = "Customdmd"

.Shapes("Customlin").Name = "tmpName"
.Shapes("Customlin").Name = "lin" & sID
.Shapes("tmpName").Name = "Customlin"

.Shapes("Customtxt").Name = "tmpName"
.Shapes("Customtxt").Name = "txt" & sID
.Shapes("tmpName").Name = "Customtxt"

.Shapes("txt" & sID).TextFrame.Characters.Text = ""
.Shapes("lin" & sID).Width = iDur2 * 1.168 - 5
With .Shapes.Range(Array("lin" & sID, "dmd" & sID, "txt" & sID)).Group
.Name = "grp" & sID
End With
.Shapes("grp" & sID).Visible = True
.Shapes("grp" & sID).Left = lLeft
End With

Obviously you'll adapt to your original to cater for pre Excel 2007

Regards,
Peter T
 
P

Peter T

This is a bit cleaner

for testing group a shape(diamond) a line, a textbox named Customdmd,
Customlin & Customtxt respectively and name the group Customgrp

Sub test()
Dim i As Long
Dim iDur2 As Double
Dim sID As String
Dim ws As Worksheet

Set ws = ActiveSheet

For i = 1 To 5
sID = Right$("0" & i, 2)
iDur2 = 50

With ws
With .Shapes("Customgrp").Duplicate
.Ungroup
End With

Call NewName(ws, "Customdmd", "dmd" & sID)
Call NewName(ws, "Customlin", "lin" & sID)
Call NewName(ws, "Customtxt", "txt" & sID)

.Shapes("txt" & sID).TextFrame.Characters.Text = ""
.Shapes("lin" & sID).Width = iDur2 * 1.168 - 5

With .Shapes.Range(Array("lin" & sID, "dmd" & sID, "txt" &
sID)).Group
.Name = "grp" & sID
End With

.Shapes("grp" & sID).Visible = True
.Shapes("grp" & sID).Left = (i - 1) * 100
End With
Next

End Sub

Function NewName(ws As Worksheet, sName As String, sNewName As String) As
Long
Dim i
With ws.Shapes
For i = .Count To 1 Step -1
If .Item(i).Name = sName Then
.Item(i).Name = sNewName
Exit For
End If
Next
End With
End Function

Peter T
 
B

Brian

Peter T,

It works like a champ in 2003, even cut down the file size a lttle bit. I'm
going to forward it to my colleague who has 2007 to see if it works.

Thanks a lot for your help
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top