Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 3300
  • Last Modified:

VBA method for creating complex shapes (combine, intersect, subtract, union) in PowerPoint?

I can't find any documentation in Office help or online for how to create complex shapes programmatically.   I simply want to select two shapes and create a new shape from the union of those two shapes.

Is there a VBA method to do this?
0
Bryce Bassett
Asked:
Bryce Bassett
2 Solutions
 
jayneeIT ManagerCommented:
I have a memory niggling at me that you can use Union, Combine, and Fragment methods on selection objects rather than shapes, but I'll need to track it down.
0
 
Rgonzo1971Commented:
Hi,

pls try
Set myDocument = ActivePresentation.Slides(1)
Set myRange = myDocument.Shapes.Range(Array("Isosceles Triangle 5", "Rectangle 4"))
myRange.MergeShapes(msoMergeUnion)

Open in new window

Reference
http://msdn.microsoft.com/en-us/library/jj230480(v=office.15).aspx
&
http://msdn.microsoft.com/en-us/library/office/jj227893.aspx

Regards
0
 
JSRWilsonCommented:
The merge commands were added to the object model in version 2013. If you have 2010 (my memory) then they will not work. The only way I know in 2010 is to select the shapes and call the ribbon commands.

Dim oshpR As ShapeRange
With ActivePresentation.Slides(1)
Set oshpR = .Shapes.Range(Array("Rectangle 3", "Rectangle 5"))
End With
oshpR.Select
CommandBars.ExecuteMso ("ShapesUnion")

Open in new window

0
Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

 
Bryce BassettFreelance VBA programmerAuthor Commented:
So close and yet so far!   Thanks for your suggestions.  

Yes, I am using PowerPoint 2010 (good memory), so msoMergeUnion is not available.

But I'm having trouble getting CommandBars.ExecuteMso ("ShapesUnion") to work.  It seems to be a problem with this specific command.  If I substitute ("Copy"), for example, it correctly puts the shapes into the buffer.  But ShapesUnion is not working.

From what I read, the commandbars method only works on "controls that are built-in
buttons, toggleButtons and splitButtons."  Is ShapesUnion considered a built-in button, even though you have to add it to the ribbon?    If that's not the problem, what else can I try?  

Let me back up here.  The two shapes I'm trying to combine are a circle and a triangle to make a little speech bubble.
combineWhat I'm aiming for is this:
goalWith help from you guys, I figured out how to draw an angular speech bubble by defining the points using BuildFreeForm.  But I couldn't figure out how to draw my circle speech bubble using the same method.  If you can point me in the right direction this whole ShapesUnion question goes away.

Thanks.
0
 
JSRWilsonCommented:
Do you get an error??

You can definitely call ShapesUnion from executeMso.

You must have at least two shapes selected. Try selecting manually and then running

Sub su()
CommandBars.ExecuteMso ("ShapesUnion")
End Sub

Open in new window


If it works:

Have you got the names of the shapes correct?
Are two shapes selected in code?
Did you use ShapesUnion NOT ShapeUnion?
0
 
Bryce BassettFreelance VBA programmerAuthor Commented:
Success!  Thanks for pointing me in the right direction with this test.  

I was selecting two shapes, and I was using ShapesUnion with an s, but I was getting a "Method .ExecuteMso of CommandBars failed" error message.  

But when I tried manually adding two normal shapes, selecting them both and running your macro, it worked fine.  

Digging deeper, I discovered that the ShapesUnion method didn't like my point shape.  The way I was drawing it did not go back to the origin point, so it left an "open sided" shape.  Adding that last segment to close the shape solved the problem.  

Here's my final code:
Sub drawhpdialogshape6(ByVal fillcolor As Integer, ByVal textcolor As Integer)  ' round bubble with tail to left

Dim ffb As FreeformBuilder
Dim mycircle As Shape
Dim mypoint As Shape
Dim mymergedshape As Shape
Dim currentslide As Slide

Set currentslide = ActivePresentation.Slides(ActiveWindow.View.Slide.SlideIndex)

Set mycircle = currentslide.Shapes.AddShape(msoShapeOval, 302.068, 164.0001, 195.8048, 202.0446)

Set ffb = currentslide.Shapes.BuildFreeform(msoEditingCorner, 364.4479, 346.1004)
With ffb
    .AddNodes msoSegmentLine, msoEditingAuto, 310.1761, 363.815
    .AddNodes msoSegmentLine, msoEditingAuto, 317.9915, 309.6834
' ShapesUnion NOT work if next line is omitted (leaving an open-sided shape)
    .AddNodes msoSegmentLine, msoEditingAuto, 364.4479, 346.1004
End With
Set mypoint = ffb.ConvertToShape

currentslide.Shapes.Range(Array(mycircle.Name, mypoint.Name)).Select
CommandBars.ExecuteMso ("ShapesUnion")

Set mymergedshape = currentslide.Shapes(currentslide.Shapes.count)

With mymergedshape
    .Fill.ForeColor.ObjectThemeColor = fillcolor
    .Fill.Visible = msoTrue
    .Line.Visible = msoFalse
End With

With mymergedshape.TextFrame
    .HorizontalAnchor = msoAnchorCenter
    .VerticalAnchor = msoAnchorMiddle
    .AutoSize = ppAutoSizeNone
    .WordWrap = msoTrue
    .MarginLeft = 20
    .MarginRight = 20
    .TextRange.font.size = 21
    .TextRange.font.Name = "Georgia"
    .TextRange.font.italic = msoTrue
    .TextRange.font.Bold = msoFalse
    .TextRange.font.color.ObjectThemeColor = textcolor
End With

End Sub

Open in new window

I'm calling this solved, but if I can tack on one more question:  You'll notice I'm setting the text in the bubble to center, and it starts centered, but when it wraps to the second line it switches to left justified.  Any idea why?

Thanks!
0
 
Bryce BassettFreelance VBA programmerAuthor Commented:
Thanks all!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now