Как обойти всплывающие окна Excel при использовании VBA в PowerPoint для обновления msoLinkedOLEObject - PullRequest
0 голосов
/ 04 октября 2018

У меня есть PowerPoint со ссылками из нескольких таблиц Excel.Я хотел бы обновить связанный объект с помощью макроса.Макрос ниже будет генерировать 2 типа всплывающих окон.Всплывающее окно появится для каждой ссылки, которая будет обновлена ​​в моем случае около 30 раз.Нажатие отмены позволит макросу продолжить.1) Microsoft Excel перестал работать (закрыть программу) 2) Используемый файл (параметры «Только чтение», «Уведомить» или «Отмена»)

Есть ли способ обойти эти сообщения?

Sub linkupdate()

Dim osld  As Slide
Dim oshp  As Shape

    For Each osld  In ActivePresentation.Slides
         For Each oshp  In osld.Shapes
            If oshp.Type = msoLinkedOLEObject Then
              If LCase(oshp.LinkFormat.SourceFullName) Like "*defect 95R*" Then
                   oshp.LinkFormat.AutoUpdate = ppUpdateOptionManual
                    oshp.LinkFormat.Update
                    oshp.LinkFormat.AutoUpdate = ppUpdateOptionAutomatic
              End If
            End If
         Next
      Next
  MsgBox "Finished updating Charts", , "Update Complete"
End Sub

1 Ответ

0 голосов
/ 09 октября 2018

Этот код предотвращал появление следующих предупреждений
1) Microsoft Excel перестал работать (закрыть программу)
2) Используемый файл (параметры «Только чтение», «Уведомить» или «Отмена»)

После завершения макроса всплывающее окно может занять минуту, прежде чем пользователь получает контроль над PowerPoint.Я предполагаю, что оповещения Excel закрываются в фоновом режиме, поскольку существует более 30 диаграмм ссылок.

Я новичок в VBA, поэтому этот код может быть неэффективным.

Sub linkUpdate()

Const xFile = "C:\temp\defect 95R.xlsx"
Dim pptPresentation As Presentation
Dim osld As Slide
Dim oshp As PowerPoint.Shape
Dim xlApp As Excel.Application

Set xlApp = New Excel.Application
xlApp.Visible = True
xlApp.Workbooks.Open xFile, ReadOnly:=True, Notify:=False
xlApp.Workbooks.Application.DisplayAlerts = False

Set pptPresentation = ActivePresentation
    'Loop through each slide in the presentation
    For Each osld In pptPresentation.Slides
        'Loop through each shape in each slide
         For Each oshp In osld.Shapes
           'Find out if the shape is a msoLinkedOLEObject type=10
            If oshp.Type = msoLinkedOLEObject Then
              'Only update shape if file name contains defect 95r
              If LCase(oshp.LinkFormat.SourceFullName) Like "*defect 95r*" Then
                   oshp.LinkFormat.AutoUpdate = ppUpdateOptionManual
                   xlApp.Workbooks.Application.DisplayAlerts = False
                    oshp.LinkFormat.Update
                    oshp.LinkFormat.AutoUpdate = ppUpdateOptionAutomatic
              End If
            End If
         Next
      Next

xlApp.Workbooks.Close
xlApp.Workbooks.Application.Quit
Set xlApp = Nothing

MsgBox "Finished updating Charts", , "Update Complete"
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...