Autoupdate Excel links in PowerPoint

Hi All,

I am a new user and have very low knowledge of coding VBA, but I can understand coded VBA.

I am writing a code and need help with the following:

My code is working fine if I try to open the PPT through Excel and is update the existing excel links in it. However, I want that as soon as the PPT is opened, Autoupdate function makes the excel-links as automatic, and just before closing the PPT, autoupdate function makes it manual.

Sub UpdateAustria()
Dim pApp As Object
Dim pPreso As Object
Dim pSlide As Object
Dim shp As Object
Dim sld As Object
Dim sPreso As String

sPreso = "C:\Macro Report\Matrix January.ppt"

On Error Resume Next
Set pApp = GetObject(, "PowerPoint.Application")

'If Err.Number <> 0 Then
Set pApp = CreateObject("PowerPoint.Application")
pApp.Visible = True
'End If

On Error Resume Next
Set pPreso = pApp.Presentations(sPreso)

'If Err.Number <> 0 Then
Set pPreso = pApp.Presentations.Open(Filename:=sPreso)
'End If

On Error GoTo 0
        For Each sld In ActivePresentation.Slides
        For Each shp In pPreso.Shapes
        If shp.Type = msoLinkedOLEObject Then
        shp.LinkFormat.AutoUpdate = ppUpdateOptionAutomatic
        End If
        Next shp
        Next sld

pPreso.UpdateLinks
pPreso.Save
pPreso.Close

End sub

Hi,

I have not got any reply on this but if anyone can look and help me with this. I have tried modifying the code. For some reasons, the PPT is opening fine but as soon as the code enters For loop, it stops working (pls see the updated code below).

Any help on this will be much appreciated. Thanks.

Sub UpdateAustria()
Dim pApp As Object
Dim pPreso As Object
Dim pSlide As Object
Dim sPreso As String
Dim i As Integer
Dim k As Integer

sPreso = "C:\Macro Report\Matrix January.ppt"


On Error Resume Next
Set pApp = GetObject(, "PowerPoint.Application")

'If Err.Number <> 0 Then
Set pApp = CreateObject("PowerPoint.Application")
pApp.Visible = True
'End If

On Error Resume Next
Set pPreso = pApp.Presentations(sPreso)

'If Err.Number <> 0 Then
Set pPreso = pApp.Presentations.Open(Filename:=sPreso)
'End If

    For i = 1 To pPreso.Slides.Count
        With pPreso.Slides(i)
            For k = 1 To .Shapes.Count
             If .Shapes(k).Type = msoLinkedOLEObject Then
                .Shapes(k).LinkFormat.AutoUpdate = ppUpdateOptionAutomatic
                .UpdateLinks
                .Shapes(k).LinkFormat.AutoUpdate = ppUpdateOptionManual
            End If
                On Error GoTo 0
            Next k
        End With
    Next i

pPreso.Save
pPreso.Close

End Sub

Yes, I get an error. Enclosed is the snapshot of the error.

Pls help.

Macro Error.JPG

Hi Mordred, would you mind looking into this.

Thanks.