Creating grouped shapes with a macro

[RandomGerman]

Hi there,

for my personal tab of useful elements I created some shapes, that I want to appear grouped. I found a piece of code for grouping, but - strange enough - it works perfect in the first example, but not in the second. I assume something important must be different in the two examples, but I can't find it, so I would appreciate any help to find out, what is going wrong in the second example. (It's only about the grouping, I guess - because the shapes themselves appear the way they should.) I'm working with 2010.

First - working:

Public Sub CallbackD004(control As IRibbonControl)
Dim shp1 As Shape
Dim shp2 As Shape
Dim sld As Slide
'Summary box
Set sld = Application.ActiveWindow.View.Slide
Set shp1 = sld.Shapes.AddShape(Type:=msoShapeRectangle, Left:=32.598405, Top:=97.228285, Width:=714.61372, Height:=39.685014)
shp1.Fill.ForeColor.RGB = RGB(227, 228, 229)
shp1.Line.ForeColor.RGB = RGB(227, 228, 229)
shp1.Line.Weight = "0"
shp1.Name = "SummaryBox"

shp1.TextFrame.TextRange.Font.Color.RGB = RGB(37, 34, 102)
shp1.TextFrame.TextRange.Characters.Text = "[Summary to come]"
shp1.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignLeft
shp1.TextFrame.VerticalAnchor = msoAnchorMiddle
shp1.TextFrame.TextRange.Font.Size = 14
shp1.TextFrame.TextRange.Font.Name = "Arial"
shp1.TextFrame.TextRange.Font.Bold = msoFalse
shp1.TextFrame.TextRange.Font.Italic = msoFalse
shp1.TextFrame.TextRange.Font.Underline = msoFalse
shp1.TextFrame.Orientation = msoTextOrientationHorizontal
shp1.TextFrame.MarginBottom = "2,8346439"
shp1.TextFrame.MarginLeft = "42,519658"
shp1.TextFrame.MarginRight = "5,6692878"
shp1.TextFrame.MarginTop = "2,8346439"

Set sld = Application.ActiveWindow.View.Slide
Set shp2 = sld.Shapes.AddShape(Type:=msoShapeChevron, Left:=48.47241, Top:=104.03143, Width:=9.6377892, Height:=26.362188)
shp2.Fill.ForeColor.RGB = RGB(37, 34, 102)
shp2.Line.ForeColor.RGB = RGB(37, 34, 102)
shp2.Line.Weight = "0,25"
shp2.Adjustments(1) = "0,62"
shp2.Name = "BulletSign"

sld.Shapes.Range(Array(shp1.Name, shp2.Name)).Group
End Sub


Second - not working:

Public Sub CallbackD023(control As IRibbonControl)
Dim shp1 As Shape
Dim shp2 As Shape
Dim sld As Slide
'Section marker Number
Set sld = Application.ActiveWindow.View.Slide
Set shp1 = sld.Shapes.AddShape(Type:=msoShapeRectangle, Left:=5.9527522, Top:=5.9527522, Width:=15.590541, Height:=15.590541)
shp1.Fill.ForeColor.RGB = RGB(37, 34, 102)
shp1.Line.ForeColor.RGB = RGB(255, 255, 255)
shp1.Line.Weight = "0"
shp1.Name = "SectionNumber"

shp1.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
shp1.TextFrame.TextRange.Characters.Text = "1"
shp1.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignCenter
shp1.TextFrame.VerticalAnchor = msoAnchorMiddle
shp1.TextFrame.TextRange.Font.Size = 12
shp1.TextFrame.TextRange.Font.Name = "Arial"
shp1.TextFrame.TextRange.Font.Bold = msoTrue
shp1.TextFrame.TextRange.Font.Italic = msoFalse
shp1.TextFrame.TextRange.Font.Underline = msoFalse
shp1.TextFrame.Orientation = msoTextOrientationHorizontal
'Section marker Textbox
Set sld = Application.ActiveWindow.View.Slide
Set shp2 = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=24.944866, Top:=5.9527522, Width:=118.48811, Height:=15.590541)
With shp2
.Fill.Visible = msoFalse
.Line.Visible = msoFalse
.Name = "SectionText"

With .TextFrame
.TextRange.Text = "[Section title to come]"
.VerticalAnchor = msoAnchorMiddle
.MarginBottom = "3,685037"
.MarginLeft = "7,0866097"
.MarginRight = "7,0866097"
.MarginTop = "3,685037"
.WordWrap = msoFalse

With .TextRange
.Font.Size = 10
.Font.Name = "Arial"
.Font.Color.RGB = RGB(115, 119, 123)
.Font.Bold = msoTrue
.ParagraphFormat.Alignment = ppAlignLeft
End With
End With
End With
sld.Shapes.Range(Array(shp1.Name, shp2.Name)).Group
End Sub


I hope someone is able to see, what I obviously don't see ...

Thank you,

RG

[John Wilson]

The second code worked for me (once I used English decimal seps)

Are you sure the names in the array are unique?

You could try this instead


shp1.Select (True)
shp2.Select (False)
ActiveWindow.Selection.ShapeRange.Group

[RandomGerman]

Oh, yes, I forgot to change the decimal seperators to English before posting here, sorry for that.

Your code works as expected, thank you for this option. But still weird things happen. I copied the old code to a new presentation and no error occured concerning the grouping, but the second shape (the section marker) was not sized and positioned the way I defined it. Only "Left" appeared as expected. The shape was a bit bigger in height and width and a bit below the coded point. Have you ever heard about something like this and do you have any experieneces, how things like this can happen?

14158

[RandomGerman]

In Addition to the problem mentioned in post #3: I found some more macros appearing not at the position defined in the code - and it seems to be dependent on the document. In some documents they do as they should, copied into another one they don't. Has anyone ever seen that before? What is the reason? And how can it be avoided?

A similar thing happens to a macro I wrote to increase text paragraphing. In one document the "+ 3" I coded work well, paragraphing after increases by 3 pt, in another document it increases by 43.2(!) pt. I'm really wondering, what is going on there and would be happy to read your ideas.

Thanks!

[RandomGerman]

As the problem mentioned in posts #3 and #4 is probably different from the original problem of this thread, I opened up a new thread for it. http://www.vbaexpress.com/forum/showthread.php?53476-Different-PPT-templates-reacting-different-on-the-same-macros

[RandomGerman]

In addition to posts #1 and #2: John's solution for grouping is (no surprise!) the better one. Mine works fine as long as one only wants to insert the group once on the slide, but as soon as one tries to add it a second time, the macro gets in trouble, probably because of the shape names already used. Thank you again, John.