Excel to PowerPoint shape resizing question

[Paul C75]

Hi all,

I have an Excel workbook with vba code to produce a PowerPoint presentation by copying, pasting, resizing and centering various Excel named ranges as OLE objects and it works perfectly when I run the code with my laptop connected to a docking station using separate display screens. If I try to run the code on my laptop alone it generates all the slides, copies and pastes all the ranges just fine, however, it does not resize the pasted object and does not center it on the slide. Here is an excerpt of the code I am using, the rest of it just repeats for other slides. Can someone tell me what I am missing please? I hope I'm posting this in the right place, any assistance would be gratefully received.

Sub pPoint()
'Invoke PowerPoint
Dim pptapp As PowerPoint.Application
Dim pptppt As PowerPoint.Presentation
Dim pptslide As PowerPoint.Slide
Dim ws As Worksheet
Dim sld As Long

'Open PowerPoint
Set pptapp = New PowerPoint.Application
pptapp.Visible = msoTrue
pptapp.Activate

'Set Slide Master properties
Set pptppt = pptapp.Presentations.Add
pptppt.SlideMaster.Background.Fill.ForeColor.RGB = RGB(198, 224, 180)

sld = 1

'Set Title Slide
Set pptslide = pptppt.Slides.Add(sld, ppLayoutTitle)
Set ws = Sheet3
pptslide.Shapes(1).TextFrame.TextRange = "Weekly Review"
pptslide.Shapes(2).TextFrame.TextRange.Text = "Week  " & Sheet3.Range("B2").Value
sld = sld + 1

'Add title slide
Set ws = Sheet1
Set pptslide = pptppt.Slides.Add(sld, ppLayoutTitleOnly)
pptslide.Select
pptslide.Shapes(1).TextFrame.TextRange = "Some Title"
pptslide.Shapes(1).TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
pptslide.Shapes(1).Select
pptapp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue
pptapp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoTrue
sld = sld + 1

'Add kpi
Set pptslide = pptppt.Slides.Add(sld, ppLayoutBlank)
pptslide.Select
ws.Range("somekpi").Copy
pptslide.Shapes.PasteSpecial ppPasteOLEObject
pptslide.Shapes(1).Width = pptppt.PageSetup.SlideWidth
pptslide.Shapes(1).Select
pptapp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue
pptapp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoTrue
sld = sld + 1

 

[Domenic]

Your code works fine for me. So it's likely a timing issue. As @Jon Peltier explains here, adding DoEvents usually helps. He also found that separating the copy and paste operations into separate procedures helps as well, in that VBA should wait until the operations are complete before entering and leaving a procedure.

So first add the following two procedures to your project. The first will paste the range onto the slide. The second one will center the object in the slide.

Function PasteRangeInSlide(ByVal pptSlide As Object) As Object

    Set PasteRangeInSlide = pptSlide.Shapes.PasteSpecial(10).Item(1) 'ppPasteOLEObject
   
    DoEvents
   
End Function

Sub CenterShapesInSlide(ByVal pptSlide As Object)

    pptSlide.Select
   
    pptSlide.Shapes.Range.Select
   
    With pptSlide.Application.ActiveWindow.Selection.ShapeRange
        .Align 4, -1 '4 = msoAlignMiddles, -1 = msoTrue
        .Align 1, -1 '1 = msoAlignCenters, -1 = msoTrue
    End With

    DoEvents
   
End Sub

Then your code for kpi would be amended as follows . . .

'Add kpi
Set pptSlide = pptppt.Slides.Add(sld, ppLayoutBlank)

ws.Range("somekpi").Copy

DoEvents

Dim pptShape As PowerPoint.Shape
Set pptShape = PasteRangeInSlide(pptSlide)

pptShape.Width = pptppt.PageSetup.SlideWidth

CenterShapesInSlide pptSlide

sld = sld + 1

Does this help?

 

[Paul C75]

Hi Domenic

Thank you for the reply. I will try this when I'm back in the office on Monday and report back. It's certainly not something I would have figured out alone, so the learning curve is always appreciated!

 

[Paul C75]

Hi Domenic

Thank you for the reply. I will try this when I'm back in the office on Monday and report back. It's certainly not something I would have figured out alone, so the learning curve is always appreciated!

Hi Domenic

Thank you for the reply. I will try this when I'm back in the office on Monday and report back. It's certainly not something I would have figured out alone, so the learning curve is always appreciated!

So, I finally got to trying out this solution and it works perfectly (it's also far more elegant than any of my code). Thanks Domenic - much appreciated!

 

[Domenic]

Hi Paul,

That's great to hear. Thanks for the feedback.

Cheers!