Function to Update chart in PowerPoint file [VBA]

Martin_H

Board Regular
Joined
Aug 26, 2020
Messages
162
Office Version
  1. 2016
Platform
  1. Windows
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.

VBA Code:
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

VBA Code:
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
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,826
Office Version
  1. 365
Platform
  1. Windows
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.

VBA 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!
 
Last edited:
Solution

Martin_H

Board Regular
Joined
Aug 26, 2020
Messages
162
Office Version
  1. 2016
Platform
  1. Windows
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 (y)
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,826
Office Version
  1. 365
Platform
  1. Windows
Hi Martin,

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

Cheers!
 

Forum statistics

Threads
1,148,195
Messages
5,745,285
Members
423,942
Latest member
excelhelp1423

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top