Adding a Disclaimer to All Presentations in a Folder

[Sal Paradise]

I am using Powerpoint 2000.

I have 6 presentations in a folder (though the number could be 10, or 20, or 40 in the future).

In each of these presentations, I have created a text box called 'Disclaimer'. I have a userform that will pop up when you run a macro, and fill in a standard disclaimer including the user-inputted client name (through the userform). However, in order to make sure each presentation has the disclaimer, the presenter would have to do this in each successive presentation, which means that there's a significant chance someone will forget, or leave the last client's name in the presentation, etc.

So what I want to do is:
When a presentation is opened, it checks to see if there is a client name in that presentation.
If the client name exists, I want to pop up a 'Yes/No' dialogue asking if the client name is correct
If the client name is correct, I want to have the macro confirm that all other presentations (.ppt) in the folder have the same client name, and if not, make sure that they are all changed to that client name
If the client name is incorrect, I want to have the macro pop up the user form to enter the client name, and then populate the 'Disclaimer' text box with the newly generated disclaimer
If the client name doesn't exist, I want to have the macro pop up the user form to enter the client name, and then populate the 'Disclaimer' text box with the newly generated disclaimerThrough this logic, any time a presentation is opened, a user should only ever have to enter the client name once to have it populate all presentations in that folder with the 'disclaimer' text box.

I am not entirely VBA illiterate, but I am also not smart enough to do things that involve anything beyond saving to a specific folder. Searching for *.ppt files is a bit beyond my ken. If you could provide any help, it would be greatly appreciated.

Here is the code for the userform (which is a textbox and a submit button):

Dim CustName
Dim Disclaimer
Dim NumSlides As Long
Dim x As Long

Private Sub Submit_Click()
Disclaimer = "Disclaimer first half" & CustName & " disclaimer second half"
CustomerName.Hide
MsgBox (Disclaimer)
NumSlides = ActivePresentation.Slides.Count
For x = 1 To NumSlides
ActivePresentation.Slides(x).Shapes("Disclaimer").TextFrame.TextRange.Text = Disclaimer
Next x
End Sub
Private Sub TextBox1_Change()
CustName = TextBox1.Value
End Sub

[John Wilson]

Steve Rindsberg has a tutorial on working with files in folders here:

http://www.pptfaq.com/FAQ00594.htm

When you say that you want the check as the pres opens do you mean automatically or are you going to load your form? If the former then you will need to produce a .ppa add in with event trapping to detect the PresentationOpen event. This is not so easy.

How will the macro detect the (unknown) customer name? It seems to be in the middle of a paragraph. I would have the original macro write a tag containg the name to eg slide one where it can be easily checked.ActivePresentation.Slides(1).Tags.Add "Name", CustName Tags are completely invisible except to vba code.

[Sal Paradise]

Steve Rindsberg has a tutorial on working with files in folders here:

<link removed as I don't have 5 posts yet and am therefore not allowed>

When you say that you want the check as the pres opens do you mean automatically or are you going to load your form? If the former then you will need to produce a .ppa add in with event trapping to detect the PresentationOpen event. This is not so easy.

How will the macro detect the (unknown) customer name? It seems to be in the middle of a paragraph. I would have the original macro write a tag containg the name to eg slide one where it can be easily checked.ActivePresentation.Slides(1).Tags.Add "Name", CustName Tags are completely invisible except to vba code. Thank you for the link. That's exactly what I was looking for but couldn't find.

As far as how to detect whether a customer name is selected, I was going to have it check when the UserForm is loaded. I don't want to mess with a .ppa, and I know that PowerPoint is inadequate in the 'on-open' area.

For figuring out if a customer name is selected, I figured that I could make a 'hidden' box on the slide master (invisible white font on white background in tiny point font or the like) with a name like 'clientname' that contains the variable only so that it can be easily checked. Would there be a problem with that as far as you know of?

[John Wilson]

Glad it helps

As fot the invisible box I would definitely learn how tags work and use those. They are truly invisible except to vba code.

[Sal Paradise]

For anyone who may be interested in doing the same thing, here is my code. I relied heavily on Chip Pearson's browse folder script and the scripts by Steve Rindsberg provided by John Wilson:

'Original credit for this code goes to Chip Pearson
'cpearson.com/excel/BrowseFolder.htm

Option Compare Text
Option Explicit

Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260

Type BrowseInfo
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszINSTRUCTIONS As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
ByVal pidl As Long, _
ByVal pszBuffer As String) As Long
Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
lpBrowseInfo As BrowseInfo) As Long
Function BrowseFolder(Optional Caption As String = "") As String

Dim BrowseInfo As BrowseInfo
Dim FolderName As String
Dim ID As Long
Dim Res As Long

With BrowseInfo
.hOwner = 0
.pidlRoot = 0
.pszDisplayName = String$(MAX_PATH, vbNullChar)
.lpszINSTRUCTIONS = Caption
.ulFlags = BIF_RETURNONLYFSDIRS
.lpfn = 0
End With
FolderName = String$(MAX_PATH, vbNullChar)
ID = SHBrowseForFolderA(BrowseInfo)
If ID Then
Res = SHGetPathFromIDListA(ID, FolderName)
If Res Then
BrowseFolder = Left$(FolderName, InStr(FolderName, _
vbNullChar) - 1)
End If
End If

End Function
Sub SelectFolder()
' Run a macro of your choosing on each presentation in a folder

Dim rayFileList() As String
Dim FolderPath As String
Dim FileSpec
Dim strTemp As String
Dim x As Long
Dim CustName As String
Dim Path As String
Dim Prompt As String
Dim Title As String

CustName = InputBox("Please Input Customer Name")

Path = BrowseFolder("Select Folder Containing Presentations")
If Path = "" Then
Prompt = "You didn't select a folder. The procedure has been canceled."
Title = "Procedure Canceled"
MsgBox Prompt, vbCritical, Title
Exit Sub
Else
FolderPath = Path & "\"
End If
FileSpec = "*.ppt"

' Fill the array with files that meet the spec above
ReDim rayFileList(1 To 1) As String
strTemp = Dir$(FolderPath & FileSpec)
While strTemp <> ""
rayFileList(UBound(rayFileList)) = FolderPath & strTemp
ReDim Preserve rayFileList(1 To UBound(rayFileList) + 1) As String
strTemp = Dir
Wend

' array has one blank element at end - don't process it
' don't do anything if there's less than one element
If UBound(rayFileList) > 1 Then
For x = 1 To UBound(rayFileList) - 1
Call ChangeDisclaimer(rayFileList(x), CustName)
Next x
End If

End Sub

Sub ChangeDisclaimer(strMyFile As String, CustName As String)
' this gets called once for each file that meets the spec you enter in ForEachPresentation
' strMyFile is set to the file name each time

' Probably at a minimum, you'd want to:
Dim oPresentation As Presentation
Set oPresentation = Presentations.Open(strMyFile)

With oPresentation

Dim oSl As Slide

For Each oSl In ActivePresentation.Slides
On Error Resume Next
oSl.Shapes("Disclaimer").Delete
On Error GoTo 0
oSl.Shapes.AddTextbox(msoTextOrientationHorizontal, 108#, 515#, 504#, 24#).Name = "Disclaimer"
With oSl.Shapes("Disclaimer")
.TextFrame.WordWrap = msoTrue
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Line.Visible = msoTrue
.Line.ForeColor.RGB = RGB(0, 0, 0)
.Line.BackColor.RGB = RGB(0, 0, 0)
End With
With oSl.Shapes("Disclaimer").TextFrame.TextRange
.Paragraphs(Start:=1, Length:=1).ParagraphFormat.Alignment = ppAlignCenter
.Text = "Disclaimer blah blah blah " & CustName & " blah blah blah."
With .Font
.NameAscii = "Arial"
.Size = 7
.BaselineOffset = 0
.Color.RGB = RGB(0, 0, 0)
End With
End With

Next oSl

oPresentation.Save
oPresentation.Close

End With

End Sub
Sub Auto_Open()

Dim NewControl As CommandBarControl

' Store an object reference to a command bar.
Dim ToolsMenu As CommandBars

' Figure out where to place the menu choice.
Set ToolsMenu = Application.CommandBars

' Create the menu choice. The choice is created in the first
' position in the Tools menu.
Set NewControl = ToolsMenu("Tools").Controls.Add(Type:=msoControlButton, Before:=1)

' Name the command.
NewControl.Caption = "Update Disclaimer Customer Name"

' Connect the menu choice to your macro. The OnAction property
' should be set to the name of your macro.
NewControl.OnAction = "SelectFolder"

End Sub
Sub Auto_Close()

Dim oControl As CommandBarControl
Dim ToolsMenu As CommandBars

' Get an object reference to a command bar.
Set ToolsMenu = Application.CommandBars

' Loop through the commands on the tools menu.
For Each oControl In ToolsMenu("Tools").Controls

' Check to see whether the comand exists.
If oControl.Caption = "Update Disclaimer Customer Name" Then

' Check to see whether action setting is set to ChangeView.
If oControl.OnAction = "SelectFolder" Then

' Remove the command from the menu.
oControl.Delete
End If
End If
Next oControl

End Sub

Works like a charm, and I made a .ppa out of it.

What I would like to do now is to make it available to select either a folder or a file, so that's the next step...

[John Wilson]

Looks good!

You might want to know that you can avoid all the API calls when locating a folder by using FileDialogs

Something like:

Sub Foldersearch()
Dim fdlg As FileDialog
Dim sFilename As String
Set fdlg = Application.FileDialog(msoFileDialogFolderPicker)
With fdlg
.AllowMultiSelect = False
If .Show = True Then
sFilename = .SelectedItems(1)
End If
End With
If sFilename = "" Then
MsgBox "No folder selected"
Else: MsgBox "Folder location is " & sFilename
End If
End Sub


There is also a msoFileDialogFilePicker dialog if that is what you need to select a file.
I think this feature goes back to PowerPoint XP

[Sal Paradise]

Unfortunately I am using Office 2000 which doesn't have some of the nicer file selection APIs built-in (you need the VBA 10.0 database or whatever the dickens it's called, and I only have 9.0). So long as it works and doesn't break anything, I'm a happy camper.

[John Wilson]

Hi Sal
Yes as I said this only goes back to 2002. The API code from Chip is useful and I might adapt it so that some of our products will work in 2000! Quite a few folk seem to want Jigsaw maker in 2000!

[Sal Paradise]

Okay, I've run into an interesting quandry.

Due to slide transition effects, I was having really annoying looking animated disclaimer boxes flying all over. So I just set the macro to go through and set the animation order to first and to make them appear such that they wouldn't cause such an eyesore on coming into the frame.

However, now when I run this on certain files I get a preview of each animation in each slide. It's the oddest thing. I can't figure out why it's only these files when I have the same slides in other presentations that it doesn't happen for.

Mind-boggling.

Is there a 'screenupdate' or somesuch that I can turn off before doing this?

[Sal Paradise]

And stranger and stranger!

I used the code found here (http://skp.mvps.org/ppt00033.htm) to turn screenupdating off, but that was a total no-go. The file doesn't even really have a window while I'm working with it, yet it looks like it's in multi-slide display mode and redraws the animation preview once for each 'With' statement I suffer it to run through.

What the heck is going on?