center object in an other application?

[Michael Freitter]

Hello!

I have record followed statements in PowerPoint: (center an object over a
slide)

ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True

Now, I want to call this function from an other application (e.g. MS-Project):

Set PSPapp = CreateObject("PowerPoint.Application")
PSPapp.Visible = msoTrue
Set PSPpraes = PSPapp.presentations.Add
Set grObjSP = PSPpraes.Slides.Add(1, ppLayoutBlank)
Set L1 = grObjSP.Shapes.AddShape(msoShapeRectangle, 10, 10, 100, 200)

And now, I want to center this rectangle over the slide, but with ...

ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True

.... do not work!

Perhaps an expert can help me!

Thank you!
Michael F.

 

[Steve Rindsberg]

I have record followed statements in PowerPoint: (center an object over a
slide)

ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True

The problem with the macro recorder is that it nearly always works with the
current selection:

ActiveWindow.Selection.ShapeRange

When you use the code elsewhere, you need to change it to work e.g. with a
reference to a shaperange:

SHAPERANGE.Align msoAlignCenters, True

so see below:

Now, I want to call this function from an other application (e.g. MS-Project):

Set PSPapp = CreateObject("PowerPoint.Application")
PSPapp.Visible = msoTrue
Set PSPpraes = PSPapp.presentations.Add
Set grObjSP = PSPpraes.Slides.Add(1, ppLayoutBlank)
Set L1 = grObjSP.Shapes.AddShape(msoShapeRectangle, 10, 10, 100, 200)

Since you have a reference to the new shaperange in L1, this should do it:

L1.Align msoAlignCenters, True

L1 needs to be defined as a shaperange, not a shape.

 

[Michael Freitter]

When I have followed code ...

Dim L1 as Object
Set PSPapp = CreateObject("PowerPoint.Application")
PSPapp.Visible = msoTrue
Set PSPpraes = PSPapp.presentations.Add
Set grObjSP = PSPpraes.Slides.Add(1, ppLayoutBlank)
Set L1 = grObjSP.Shapes.AddShape(msoShapeRectangle, 10, 10, 100, 200)

L1.Align msoAlignCenters, True

.... then the rectangle is drawing correct, but an error by "L1.Align
msoAlignCenters, True" occured.

When I define "Dim L1 as ShapeRange" instead "Dim L1 as Object", the error
is by the line "Set L1 = grObjSP.Shapes.AddShape(msoShapeRectangle, 10, 10,
100, 200)"

Can you help me again?
Thank you!
Michael F.

 

[Steve Rindsberg]

Dim L1 as Object
Set PSPapp = CreateObject("PowerPoint.Application")
PSPapp.Visible = msoTrue
Set PSPpraes = PSPapp.presentations.Add
Set grObjSP = PSPpraes.Slides.Add(1, ppLayoutBlank)
Set L1 = grObjSP.Shapes.AddShape(msoShapeRectangle, 10, 10, 100, 200)

L1.Align msoAlignCenters, True

Dim L1 as Object
Set PSPapp = CreateObject("PowerPoint.Application")
PSPapp.Visible = msoTrue
Set PSPpraes = PSPapp.presentations.Add
Set grObjSP = PSPpraes.Slides.Add(1, ppLayoutBlank)
Set L1 = grObjSP.Shapes.AddShape(msoShapeRectangle, 10, 10, 100, 200)

L1.Align msoAlignCenters, True

This should work better:
Align requires a shaperange rather than a shape as parameter but adding a new
shape returns a shape, not a range. Using .Range converts the shape to a
shaperange.

Dim L1 As ShapeRange
Dim oSh As Shape
Set PSPapp = CreateObject("PowerPoint.Application")
PSPapp.Visible = msoTrue
Set PSPpraes = PSPapp.Presentations.Add
Set grObjSP = PSPpraes.Slides.Add(1, ppLayoutBlank)

Set oSh = grObjSP.Shapes.AddShape(msoShapeRectangle, 10, 10, 100, 200)
Set L1 = grObjSP.Shapes.Range(oSh.Name)

L1.Align msoAlignCenters, True


End Sub

 

[Michael Freitter]

Sorry, but an error occur, when I run your code:

In the line "Set oSh = grObjSP.Shapes.AddShape(msoShapeRectangle, 10, 10,
100, 200)" the followed error: Run-time error '13'; Type mismatch.

I have run the code in MS-Project 2003 and with PowerPoint 2003.

Thank you!
Michael Freitter

 

[Steve Rindsberg]

I'm having to adapt your code to something that'll run from within PPT itself to
test it; I may've made a mistake in translating it back to the context you're
using.

Try it from within PPT:

Sub Test()

Dim L1 As ShapeRange
Dim oSh As Shape
Dim grObjSP As Slide

'Set PSPapp = CreateObject("PowerPoint.Application")
'PSPapp.Visible = msoTrue
'Set PSPpraes = PSPapp.Presentations.Add
' Set grObjSP = PSPpraes.Slides.Add(1, ppLayoutBlank)
Set grObjSP = ActivePresentation.Slides.Add(1, ppLayoutBlank)

Set oSh = grObjSP.Shapes.AddShape(msoShapeRectangle, 10, 10, 100, 200)
Set L1 = grObjSP.Shapes.Range(oSh.Name)

L1.Align msoAlignCenters, True

End Sub

This works here.