Function to Update chart in PowerPoint file [VBA]

[Martin_H]

Hi,

I am using a macro (see below) to update multiple charts in multiple PowerPoint files (macro is stored in .xlm file).

The macro is calling multiple functions (SV1, SV2, SV3, SV4, SV5, SV6).

Each function is dedicated to update specific PowerPoint file.

The question is: Do I need 6 separated functions to update 6 different PowerPoint files (6 different location addresses)?

Is it possible to - somehow - combine these 6 functions into one?

Thank you.

Sub Update_PPTX
'Main code

With Application
.ScreenUpdating = False

Call SV1
Call SV2
Call SV3
Call SV4
Call SV5
Call SV6

.ScreenUpdating = True
End With

End Sub

Function SV1()
Set PPT = CreateObject("PowerPoint.Application")
PTT.Visible = True
PTT.Presentations.Open "address1", Untitled:=msoTrue
PTT.ActivePresentation.UpdateLinks
PTT.ActivePresentation.SaveAs Filename:="address1"
PTT.Quit
Set PPT = Nothing
End Function

Function SV2()
Set PPT = CreateObject("PowerPoint.Application")
PTT.Visible = True
PTT.Presentations.Open "address2", Untitled:=msoTrue
PTT.ActivePresentation.UpdateLinks
PTT.ActivePresentation.SaveAs Filename:="address2"
PTT.Quit
Set PPT = Nothing
End Function

Function SV3()
Set PPT = CreateObject("PowerPoint.Application")
PTT.Visible = True
PTT.Presentations.Open "address3", Untitled:=msoTrue
PTT.ActivePresentation.UpdateLinks
PTT.ActivePresentation.SaveAs Filename:="address3"
PTT.Quit
Set PPT = Nothing
End Function

Function SV4()
Set PPT = CreateObject("PowerPoint.Application")
PTT.Visible = True
PTT.Presentations.Open "address4", Untitled:=msoTrue
PTT.ActivePresentation.UpdateLinks
PTT.ActivePresentation.SaveAs Filename:="address4"
PTT.Quit
Set PPT = Nothing
End Function

Function SV5()
Set PPT = CreateObject("PowerPoint.Application")
PTT.Visible = True
PTT.Presentations.Open "address5", Untitled:=msoTrue
PTT.ActivePresentation.UpdateLinks
PTT.ActivePresentation.SaveAs Filename:="address5"
PTT.Quit
Set PPT = Nothing
End Function

Function SV6()
Set PPT = CreateObject("PowerPoint.Application")
PTT.Visible = True
PTT.Presentations.Open "address6", Untitled:=msoTrue
PTT.ActivePresentation.UpdateLinks
PTT.ActivePresentation.SaveAs Filename:="address6"
PTT.Quit
Set PPT = Nothing
End Function

 

[Domenic]

Simply use the Array function to assign a list of filenames, including their paths, to a Variant variable. Then, pass the variable to a single function so that it loops through the array of filenames, opens each file, etc.

By the way, with regards to your original code, you've assigned the PowerPoint application to the variable PPT, while subsequently using PTT instead. If you had included the statement 'Option Explicit' at the very top of the module, it would have forced you to declare all variables, and you would have caught the error.

Also, you'll notice, with my code, I have the function return a Boolean value. It returns True when successful. Otherwise, it returns False. If it returns True, a message box is displayed to tell the user that it has been successful. However, if you'd prefer not having the message box displayed, simply remove that part of the code.

Option Explicit

Sub Update_PPTX()
'Main code

    Application.ScreenUpdating = False
  
    Dim vFileNames As Variant
    vFileNames = Array("address1", "address2", "address3", "address4", "address5")
  
    Dim bCompleted As Boolean
    bCompleted = SV(vFileNames)
  
    'Optional
    If bCompleted Then
        MsgBox "Completed . . .", vbInformation, "Completed"
    End If

    Application.ScreenUpdating = True
  
End Sub

Function SV(ByRef vFileNames As Variant) As Boolean

    On Error GoTo errorHandler

    Dim PPT As Object
    Set PPT = CreateObject("PowerPoint.Application")
  
    PPT.Visible = True
  
    Dim PPres As Object
    Dim i As Long
    For i = LBound(vFileNames) To UBound(vFileNames)
        Set PPres = PPT.Presentations.Open(vFileNames(i))
        With PPres
            .UpdateLinks
            .Save
            .Close
        End With
        Set PPres = Nothing
    Next i
      
    PPT.Quit
    Set PPT = Nothing
  
    SV = True
  
    Exit Function
  
errorHandler:
    If Not PPres Is Nothing Then
        PPres.Close
        Set PPres = Nothing
    End If
  
    If Not PPT Is Nothing Then
        PPT.Quit
        Set PPT = Nothing
    End If
  
    SV = False
  
    MsgBox "Error: " & Err.Number & vbCrLf & vbCrLf & Err.Description, vbCritical, "Error"
  
End Function

Hope this helps!

 

[Martin_H]

Hi Domenic.

This is absolutely amazing. Thanks for the feedback about the errors I made in my code.

Love your solution even the errorHandler is very handy. I will surely use it.

Thank you for your help mate. I appreciate it

 

[Domenic]

Hi Martin,

That's great, glad I could help. And thanks for your feedback.

Cheers!