Search code examples
vbagroupingpowerpointshapespowerpoint-2007

VBA Powerpoint Grouping Array?


I want to create a code that will resize a selected image, position it accordingly, create 2 text boxes beneath it, and finally group the image and 2 text boxes together.

My overall goal is to make 2 additional macros that will do the same function but position them in the middle and right.

I can't seem to figure out how to group the 3 shapes.

Here's my code below.

Dim LeftPic As ShapeRange, sld As Slide, ByeBox As Shape, HelloBox As Shape

Set LeftPic = ActiveWindow.Selection.ShapeRange
Set sld = Application.ActiveWindow.View.Slide

With LeftPic
    .Left = 0.17 * 72 '72 is the multiplier for the inch
    .Top = 1.83 * 72
    .Height = 4.27 * 72
    .Width = 3.2 * 72
End With

LeftPic.Name = "LeftPic"

Set HelloBox = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
    0.17 * 72, Top:=6.17 * 72, Width:=200, Height:=50)
HelloBox.TextFrame.TextRange.Text = "Hello"
HelloBox.Name = "HelloBox"

Set ByeBox = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
0.17 * 72, Top:=6.42 * 72, Width:=200, Height:=50)
ByeBox.TextFrame.TextRange.Text = "Goodbye"
ByeBox.Name = "ByeBox"

Shapes.Range(Array("HelloBox", "ByeBox", "LeftPic")).Group

Solution

  • Dim LeftPic As ShapeRange, sld As Slide, ByeBox As Shape, HelloBox As Shape
    
    Set LeftPic = ActiveWindow.Selection.ShapeRange
    Set sld = Application.ActiveWindow.View.Slide
    
    With LeftPic
        .Left = 0.17 * 72 '72 is the multiplier for the inch
        .Top = 1.83 * 72
        .Height = 4.27 * 72
        .Width = 3.2 * 72
    End With
    
    LeftPic.Name = "LeftPic"
    
    Set HelloBox = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
        0.17 * 72, Top:=6.17 * 72, Width:=200, Height:=50)
    HelloBox.TextFrame.TextRange.Text = "Hello"
    HelloBox.Name = "HelloBox"
    
    Set ByeBox = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, _
    0.17 * 72, Top:=6.42 * 72, Width:=200, Height:=50)
    ByeBox.TextFrame.TextRange.Text = "Goodbye"
    ByeBox.Name = "ByeBox"
    
    sld.Shapes("HelloBox").Select
    sld.Shapes("ByeBox").Select msoFalse
    sld.Shapes("LeftPic").Select msoFalse
    ActiveWindow.Selection.ShapeRange.Group