CODEWITHSUNDEEP
excelvbachartspowerpoint
john
john

Reputation: 191

How to position my picture at the center of the slide in my existing powerpoint slide using VBA?

Firstly, my charts are copied as picture and when i tried to paste it, the object doesn't support this property or method error occurred at the line For Each oSh In PPTPres.Slides(28). But ultimately, i want my picture to be pasted at the center of the slide 28, and slightly smaller. Can anyone tell me where have i done wrong here and how should i rectify it?

 Option Explicit

 Sub ExportChartsToPowerPoint_SingleWorksheettesting()

    'Declare PowerPoint Variables
    Dim PPTApp As Object
    Dim PPTPres As Object
    Dim PPTShape As Object
    Dim mySlide As Object
    Dim myslide2 As Object

        Dim i As Long


    'Declare Excel Variables
    Dim Chrt As ChartObject

If PPTApp Is Nothing Then _
Set PPTApp = CreateObject(class:="PowerPoint.Application")

On Error GoTo 0
        PPTApp.Visible = True

    'Create new presentation in the PowerPoint application.
      Set PPTPres = PPTApp.Presentations.Open(Filename:="\\fab2crp-nas1\home22\kkang2\Profile\Desktop\myassignment3\mypresentationsample.pptx")

   Dim ppSlide As PowerPoint.Slide
        Set ppSlide = PPTPres.Slides(28)

        Dim j As Integer
        For j = ppSlide.Shapes.Count To 1 Step -1
            If ppSlide.Shapes(j).Type = msoPicture Then
                ppSlide.Shapes(j).Delete
            End If
        Next j


With PPTPres.Slides(28)
Sheets(4).Range("A1:M34").CopyPicture
            ppSlide.Shapes.Paste
End With


    Dim oSh As Shape

        For Each oSh In PPTPres.Slides(28) '<---object doesn't support this property or method
            With oSh
                If .Type = msoLinkedPicture _
                Or .Type = msoPicture Then

                ' position it to taste
                .Left = 100
                .Top = 100

                End If
            End With
        Next    ' Shape

End Sub

Currently

enter image description here

Expected

enter image description here

debug.print

enter image description here

Upvotes: 1

Views: 1108

Answers (1)

Tim Williams
Tim Williams

Reputation: 166316

Try this (example code):

Sub Tester()

    Dim PPTApp As Object
    Dim PPTPres As Object
    Dim ppSlide As PowerPoint.Slide
    Dim Chrt As ChartObject
    Dim oSh 'As ShapeRange
    Dim pgSet

    'using already open PPT for testing....
    Set PPTApp = GetObject(, "PowerPoint.Application") 'get open ppt
    Set ppSlide = PPTApp.Presentations(1).Slides(1)    'the open presentation
    Set pgSet = PPTApp.Presentations(1).PageSetup      'for slide width/height

    Sheets(1).Range("A1:M34").CopyPicture
    Set oSh = ppSlide.Shapes.Paste() '<< get the pasted shape

    'center on slide
    With oSh
        .Left = (pgSet.SlideWidth - .Width) / 2
        .Top = (pgSet.SlideHeight - .Height) / 2
    End With

End Sub

Upvotes: 3

Related Questions