Как расположить мое изображение в центре слайда в моем существующем слайде PowerPoint, используя VBA? - PullRequest
0 голосов
/ 29 марта 2020

Во-первых, мои диаграммы копируются как рисунки, и когда я пытался вставить их, объект не поддерживает это свойство или метод, произошла ошибка в строке Для каждого o Sh В PPTPres.Slides (28) . Но, в конечном счете, я хочу, чтобы моя картинка была вставлена ​​в центр слайда 28 и немного меньше. Может кто-нибудь сказать мне, где я сделал не так и как мне исправить это?

 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

В настоящее время

enter image description here

Ожидается

enter image description here

debug.print

enter image description here

1 Ответ

2 голосов
/ 29 марта 2020

Попробуйте это (пример кода):

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...