Как обновить Powerpoint slide из Excel без активации окна Powerpoint - PullRequest
0 голосов
/ 09 февраля 2019

Я хочу отображать расписание рейсов на 3 дисплеях.Мы вносим изменения в расписание через документ Excel, и мой код отображает расписание, копируя изображение из Excel и вставляя его в работающую точку Power каждые x секунд.Однако я обеспокоен тем, что пользователи будут раздражены тем, что при запуске кода активируются 3 разных окна powerpoint, что прервет другую работу на компьютере.Сейчас я активирую окно и манипулирую слайдами.Это способ CopyPicture из Excel и вставка его в слайд уже работающей PowerPoint в фоновом режиме, не активируя окно и не отвлекая пользователя?

Пожалуйста, не судите мой изменчивый неэффективный код ... ЯЯ учусь через Google и ничего не кодировал в течение 10 лет.Я также вставляю слайд 2, чтобы я мог поместить фигуру перед тем, как поместить ее на слайд 1 (что на мониторах), чтобы при каждом выполнении кода не происходило смещение экрана.

Вот мой код:

'Set the source workbook
Set wkbSource = ThisWorkbook

'Set the named range
Set rSource = ThisWorkbook.ActiveSheet.Range("B2:N70")
Set rSource2 = ThisWorkbook.ActiveSheet.Range("Q2:AC70")
Set rSource3 = ThisWorkbook.ActiveSheet.Range("AF2:AT70")


        '''''''''DISPLAY 1''''''''

'Get the existing instance of PowerPoint
Set oPPT = GetObject(, "PowerPoint.Application")

'Set the presentation
Set oPres = oPPT.Presentations("Display1.pptx")

'Clear contents of slide 2
    On Error Resume Next
    'Is the PowerPoint open?
    Set objApp = CreateObject("PowerPoint.Application")
    On Error GoTo 0

    If objApp Is Nothing Then Exit Sub

    If objApp.ActivePresentation Is Nothing Then Exit Sub

        Set objSlide = objApp.ActivePresentation.Slides(2)
            For Each ObjShp In objSlide.Shapes
                Select Case ObjShp.Type
                    Case msoPicture, msoTable, msoChart
                        ObjShp.Delete
                End Select
            Next

'Define Slide 2
Set oSlide2 = oPres.Slides(2)

'Copy the range as a picture
rSource.CopyPicture xlScreen, xlPicture

'Make the presentation the active presentation
oPres.Windows(1).Activate

'Paste picture in the newly added slide
Set oShape2 = oSlide2.Shapes.Paste(1)

'Go to the newly added slide
oPPT.ActiveWindow.View.GotoSlide oPres.Slides.Count

'Resize if Width is larger than slide
    NewWidth = oPres.PageSetup.SlideWidth
    If oShape2.Width > NewWidth Then
        oShape2.LockAspectRatio = msoTrue
        oShape2.Width = NewWidth - 50
    End If

'Resize if Height is larger than slide
  NewHeight = oPres.PageSetup.SlideHeight

    If oShape2.Height > NewHeight Then
        oShape2.LockAspectRatio = msoTrue
        oShape2.Height = NewHeight - 50
    End If

'Center the picture horizontally and vertically

With oPres.PageSetup
    oShape2.Left = (.SlideWidth / 2) - (oShape2.Width / 2)
    oShape2.Top = (.SlideHeight / 2) - (oShape2.Height / 2)
End With

With oPres

    .Slides(2).Shapes.Range(1).copy

    'Clear contents of slides
    On Error Resume Next
    'Is the PowerPoint open?
    Set objApp = CreateObject("PowerPoint.Application")
    On Error GoTo 0

    If objApp Is Nothing Then Exit Sub

    If objApp.ActivePresentation Is Nothing Then Exit Sub

        Set objSlide = objApp.ActivePresentation.Slides(1)
            For Each ObjShp In objSlide.Shapes
                Select Case ObjShp.Type
                    Case msoPicture, msoTable, msoChart
                        ObjShp.Delete
                End Select
            Next


    .Slides(1).Shapes.Paste
    .Slides(1).Select

End With

И это продолжается, чтобы обновить еще 2 презентации Powerpoint.Спасибо за любую помощь заранее!

JR

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...