So someone has decided that your current Powerpoint template sucks and needs to be replaced with a shiny new template. Next question is, how do you update the 500+ legacy powerpoint presentations to the new template with a minimal amount of pain?
Not VB! I should have bit the bullet and done this in C# but it evolved from a simple sub to a larger script. In any case, it works well enough and gets most slides right. The goal was to be able to tolerate slide decks with multiple masters and only replace the background on slides using the previous template. It's very chatty so redirect the output to a log file for large runs. Also, rename the new Design to something unique so you can tell the new slides from the old ones later in case you need to re-run the script.
Save the following code to a .vbs file and modify the top variables to reflect your own environment.
EnumDesigns is taken from
http://skp.mvps.org/designs.htmCheckFolders is from
http://www.windowsdevcenter.com/examples/windows/vbscriptpr_code.html
' setNewMasterDesign.vbs
' This script will find ppts under the current directory, and set the template and
' design to the current corporate template.
' Makes duplicates of all slides found.
' Works with PPT 2003 on WinXP
' (c) Dave S. Aug 11 2008
Dim currDir, templateFile, suffix, masterReplaceString, newDesign
suffix=".ppt"
''''''''
' User defined variables
currDir = "."
' Where is the source template for the new master?
templateFile = "C:\mytemplates\Default.pot"
' Change this to whatever substring matches your old master slide design(s)
masterReplaceString = "Default"
' This is the name of the new Design to be applied to slides whose Design name matches masterReplaceString
newDesign = "FreshAndClean"
'''''''''''''
WScript.Echo "Start Time:" & Now
Set FSO = CreateObject("Scripting.FileSystemObject")
Set folder = FSO.GetFolder(currDir)
Set files = folder.Files
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = true
WScript.Echo templateFile & " is being opened...."
Set masterPPT = objPPT.Presentations.Open(templateFile)
EnumDesigns(masterPPT)
' Search recursively for powerpoint files in the current directory
CheckFolder folder, suffix, masterReplaceString
objPPT.Quit
''''''''''''''''''''''''''''''''''''''
' Subs Begin
''''''''''''''''''''''''''''''''''''''
Sub CheckFolder(objCurrentFolder, suffix, masterReplaceString)
Dim strTemp
Dim strSearch
Dim objNewFolder
Dim objFile
strSearch = suffix
WScript.Echo "Current folder is: " & objCurrentFolder.Name
'Recurse through all of the folders, go to bottom first
For Each objNewFolder In objCurrentFolder.subFolders
CheckFolder objNewFolder, suffix
Next
For Each objFile In objCurrentFolder.Files
strTemp = Right(objFile.Name, 4)
If UCase(strTemp) = UCase(strSearch) Then
massagePPT objFile, masterReplaceString
End If
Next
End Sub
' ppt file filtering is done in CheckFolder, not in massagePPT
Sub massagePPT(objFile, masterReplaceString)
Dim fullfile
fullFile = objFile.Path
WScript.Echo fullFile & " being opened at " & Now
Set objPresentation = objPPT.Presentations.Open(fullFile)
objPresentation.Designs.Load templateFile
With objPresentation
If Not .HasTitleMaster Then .AddTitleMaster
End With
EnumDesigns(objPresentation)
Dim MySlide
Dim slideNum
slideNum = 0
WScript.Echo "Presentation: " & objFile.Name
For Each MySlide In objPresentation.Slides
slideNum = slideNum + 1
Dim text
Dim designName
designName = ""
With MySlide
WScript.Echo "Master:" & .Master.Name
WScript.Echo "Design:" & .Master.Design.Name
designName = .Master.Design.Name
WScript.Echo "SlideNum:" & slideNum
WScript.Echo "Layout:" & .Layout
End With
' Test if the design name is the one we want to replace
If InStr(1,designName,masterReplaceString) = 0 Then
WScript.Echo "Skipping slide " & slideNum & " due to non-matching master design: " & designName
Else
WScript.Echo "Slide " & slideNum & " Master Design name matches: " & masterReplaceString
' This section controls which design elements will propagate to the target slides
' In my case, I care mostly about the background but want to leave out master shapes and color schemes
With MySlide
.FollowMasterBackground = True
' .ColorScheme = objPresentation.SlideMaster.ColorScheme
.DisplayMasterShapes = False
.Design = objPresentation.Designs(newDesign)
End With
End If
Next
objPresentation.SaveAs(objFile.Path & "." & newDesign & ".ppt")
objPresentation.Close
End Sub
Sub EnumDesigns(oPres)
Dim lCtrA
With oPres
WScript.Echo "Number of applied templates: " & .Designs.Count
For lCtrA = 1 To .Designs.Count
WScript.Echo "Template Design name: " & .Designs(lCtrA).Name
WScript.Echo vbTab & "Slide master name: " & .Designs(lCtrA).SlideMaster.Name
If .Designs(lCtrA).HasTitleMaster Then
WScript.Echo vbTab & "Title master name: " & .Designs(lCtrA).TitleMaster.Name
Else
WScript.Echo vbTab & "No Title master present"
End If
Next
End With
End Sub
