Solved

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

Posted on 2014-03-06
7
2,426 Views
Last Modified: 2014-03-08
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
Comment
Question by:versatilebb
7 Comments
 
LVL 7

Expert Comment

by:jaynee
ID: 39911714
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
 
LVL 48

Assisted Solution

by:Rgonzo1971
Rgonzo1971 earned 50 total points
ID: 39911759
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
 
LVL 23

Accepted Solution

by:
JSRWilson earned 200 total points
ID: 39911792
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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:versatilebb
ID: 39913366
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
 
LVL 23

Expert Comment

by:JSRWilson
ID: 39914637
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
 

Author Comment

by:versatilebb
ID: 39914911
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
 

Author Closing Comment

by:versatilebb
ID: 39914914
Thanks all!
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

 Regular Expressions Microsoft Word has sophisticated search tools that can search for patterns. For example if you wanted to search for all UK phone numbers that followed a pattern of five digits, a space and then six digits you can easily do th…
Entering a date in Microsoft Access can be tricky. A typo can cause month and day to be shuffled, entering the day only causes an error, as does entering, say, day 31 in June. This article shows how an inputmask supported by code can help the user a…
The viewer will learn how to make their project stand out over others by learning how to change colors and shapes, add spaces, change directions, and add bullets to their charts.
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now