MergeShapes

[Dossfm0q]

repeated
I don't want to select or enable Power point reference ,and need to Merge Shapes but there is Error

Public Sub MangePPTFromExcel()


Dim PPT As Object
Dim Pres As Object
'Dim Sld As Slide' have to go to: Tools --> select Microsoft PowerPoint ? object Library
Dim Sld As Object 'not work with .Shapes.Range(Array("Shpe Name 1", "Shpe Name 2")).MergeShapes (msoMergeCombine)
Dim Names(1 To 2) As Variant
'Dim Shp As PowerPoint.Shape, Rctangl As PowerPoint.Shape, Rctangll As PowerPoint.Shape, MergeShape As PowerPoint.Shape
Dim Shp As Shape, Rctangl As Shape, Rctangll As Shape, MergeShape As Shape


Set PPT = CreateObject("Powerpoint.Application")
Set Pres = PPT.Presentations.Add
'Set Sld = Pres.Slides.Add(1, ppLayoutBlank)
Set Sld = Pres.Slides.Add(1, 12)


    With Sld
            Set Rctngl1 = .Shapes.AddShape(msoShapeRectangle, 100, 100, 125, 200)
                With Rctngl1
                    .Name = "MyRectangle"
                    Names(1) = .Name
                    Lft = .Left
                    Tp = .Top
                    
                End With
           ' Add Hole
            Set Rctngl = .Shapes.AddShape(msoShapeOval, Rctngl1.Left + (Rctngl1.Width * 0.5) - 15, Rctngl1.Top + 15, 30, 30)
                With Rctngl
                    .Name = "Oval"
                    Names(2) = .Name
        
                End With
             Set Shps = .Shapes.Range(Names)
            With Shps '.Shapes.Range(Names)
            .Select
            End With
            
           [COLOR=#ff0000]  .Shapes.Range(Array("MyRectangle", "Oval")).MergeShapes (msoMergeCombine) [/COLOR]' works well if declare Sld as Slide, but i need to be worked with Sld As Object
    End With


End Sub

 

[Domenic]

Just thought I would let you know that I tried your code and I get the same results as you do. Although the syntax seems to be correct, it looks like it's only a problem when using late binding. After searching Google, the only thing I could find is a suggestion that it's a bug. It likely is a bug. Have you thought about grouping your shapes instead? To group them, you could do it this way...

.Shapes.Range(Array(Rctngl1.Name, Rctngl.Name)).Group

 

[Dossfm0q]

thank you for respond
I need to Combine multi shapes in one shape, this feature can be happen with Power point only,I can group shape by Excel (or declare Sld as slide ) .but I want to Combine shapes by my way.

Thanks sir

 

[Dossfm0q]

it is solved by:
PPT.CommandBars.ExecuteMso ("ShapesCombine")
to Combine

Public Sub MangeCombinePPTFromExcel()


Dim PPT As Object
Dim Pres As Object
Dim Sld As Object
Dim Names(1 To 2) As Variant
Dim Shp As Shape, Rctangl As Shape, Rctangll As Shape, MergeShape As Shape


Set PPT = CreateObject("Powerpoint.Application")
Set Pres = PPT.Presentations.Add
Set Sld = Pres.Slides.Add(1, 12)


    With Sld
            Set Rctngl1 = .Shapes.AddShape(msoShapeRectangle, 100, 100, 125, 200)
                With Rctngl1
                    .Name = "MyRectangle"
                    Names(1) = .Name
                    Lft = .Left
                    Tp = .Top
                    
                End With
           ' Add Hole
            Set Rctngl = .Shapes.AddShape(msoShapeOval, Rctngl1.Left + (Rctngl1.Width * 0.5) - 15, Rctngl1.Top + 15, 30, 30)
                With Rctngl
                    .Name = "Oval"
                    Names(2) = .Name
        
                End With
             Set Shps = .Shapes.Range(Names)
            With Shps '.Shapes.Range(Names)
            .Select
            End With
            [COLOR=#006400][B]PPT.CommandBars.ExecuteMso ("ShapesCombine") [/B][/COLOR]'it works
            '.Shapes.Range(Array("MyRectangle", "Oval")).MergeShapes (msoMergeCombine) ' under trial
    End With
End Sub

or PPT.CommandBars.ExecuteMso ("ShapesUnion") 'it works
to Union

Public Sub MangeUnionPPTFromExcel()
Dim PPT As Object
Dim Pres As Object
Dim Sld As Object
Dim Names(1 To 2) As Variant
Dim Shp As Shape, Rctangl As Shape, Rctangll As Shape, MergeShape As Shape


Set PPT = CreateObject("Powerpoint.Application")
Set Pres = PPT.Presentations.Add
Set Sld = Pres.Slides.Add(1, 12)


    With Sld
            Set Rctngl1 = .Shapes.AddShape(msoShapeRectangle, 100, 100, 125, 200)
                With Rctngl1
                    .Name = "MyRectangle"
                    Names(1) = .Name
                    Lft = .Left
                    Tp = .Top
                    
                End With
           ' Add Hole
            Set Rctngl = .Shapes.AddShape(msoShapeOval, Rctngl1.Left - 15, Rctngl1.Top + 15, 30, 30)
                With Rctngl
                    .Name = "Oval"
                    Names(2) = .Name
        
                End With
             Set Shps = .Shapes.Range(Names)
            With Shps '.Shapes.Range(Names)
            .Select
            End With
[B][COLOR=#006400]            PPT.CommandBars.ExecuteMso ("ShapesUnion") 'it works[/COLOR][/B]
            '.Shapes.Range(Array("MyRectangle", "Oval")).MergeShapes (msoMergesUnion) ' under trial
    End With
End Sub

thanks for who respond