通过 Excel 完成宏后，PowerPoint 显示错误“上传被阻止”

Question

这不是最实用的方法，但是我尝试过的其他示例都不起作用。

我的目标是通过Excel VBA刷新PPT链接。

我的老板有一个包含我们项目状态的 Excel 电子表格。我使用 Raspberry Pi 通过 PowerPoint 将其显示在电视显示器上。
我在 Excel 中做了一个“刷新”按钮。在电子表格中添加更多内容后，它将更新 PowerPoint。

一切正常，除了当我刷新后尝试打开 PowerPoint 时，我看到：

我将其保存到云端，以便公司中的每个人都可以访问。我收到错误消息，而不是我的老板。

Sub CopyRangeToPowerPoint()
    
    'Declare PowerPoint Variables
    Dim PP As PowerPoint.Application
    Dim PPPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide
    
    Dim SlideTitle As String
    
    Dim exlRange As Range
    Dim filePath As String
    
    'Opening PowerPoint and Creating a new Presentation
    Set PP = CreateObject("PowerPoint.Application")
    Set PPPres = PP.Presentations.Add
   
    'PP.ActiveWindow.WindowState = ppWindowMinimized
    
    'Defining the path
    filePath = ("PathToFile\TV Display PowerPoint.pptx")

    PP.DisplayAlerts = ppAlertsNone
    
    'Adding a new slide in PowerPoint Presentation and selecting that slide for further use
    For i = PPPres.Slides.Count To 1 Step -1
        Set PPSlide = PPPres.Slides(i)
        PPSlide.Delete
    Next i

    Set PPSlide = PPPres.Slides.Add(1, ppLayoutLargeObject)
    PPSlide.Select
    
    Set exlRange = Range("A1:H45")
    
    exlRange.Copy
    
    PPSlide.Shapes.Paste
    
    PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    
    PP.Activate
    PPPres.SaveAs (filePath)
    
    'PP.ActiveWindow.WindowState = ppWindowMaximized
    PPPres.Close
    PP.Quit
    
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PP = Nothing
    
End Sub

我有一种感觉，它与保存在同一路径上有关，但我需要它位于同一位置。

Answer 1

这是解决我的问题的代码。我相信我之前保存它的方式导致了这个“上传被阻止”错误消息。

Sub CopyRangeToPowerPoint()



'Declare PowerPoint Variables

Dim PP As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide

Dim SlideTitle As String

Dim exlRange As Range
Dim filePath As String

'Opening PowerPoint and Creating a new Presentation

Set PP = CreateObject("PowerPoint.Application")

With Application
    .ScreenUpdating = False
    .Calculation = xlManual

End With


Set PPPres = PP.Presentations.Open("PATH TO FILE")
PP.DisplayAlerts = ppAlertsNone
'PP.ActiveWindow.WindowState = ppWindowMinimized





'Deleting current slide 
For i = PPPres.Slides.Count To 1 Step -1
    Set PPSlide = PPPres.Slides(i)
    PPSlide.Delete
Next i


Set PPSlide = PPPres.Slides.Add(1, ppLayoutLargeObject)
PPSlide.Select

Set exlRange = Range("A1:H45")

exlRange.Copy

PPSlide.Shapes.Paste


PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True



PP.Activate



    With Application

    .Calculation = xlAutomatic
    .ScreenUpdating = True
End With

PPPres.Save
PPPres.Close
PP.Quit


Set PPSlide = Nothing
Set PPPres = Nothing
Set PP = Nothing



End Sub