Permanently Change the Colour of the Pen

  • Thread starter Thread starter TMC
  • Start date Start date
T

TMC

I would like to permanently change the colour of the pen
to white in all my PowerPoint files. Right now, every
time we open the file we have to change the colour from
black to white. Any suggestions?

Thanks
 
You can set the color for the presentation file, or better yet, you can set
it at the template level. All presentations created with the template will
have the color set to white. Would that do it for you? It might mean
setting it for a handful of templates, but it's a one time quick task.
 
You can open each show and on the Slide Show menu, click Set Up Show and
then change the pen color. I don't think that you would want it to
always default to one specific color unless you alway use the same
background in which case you might want to create a new template with
the new pen color selected.

Hope this helps.
K
 
This macro will change the pen color:

Sub SetPenColor()
With ActivePresentation.SlideShowSettings
' Use one of the scheme colors ...
.PointerColor.SchemeColor = ppFill
' or uncomment this to use an RGB color
'.PointerColor.RGB = RGB(Red:=91, Green:=195, Blue:=126)
End With
End Sub

You could save this in one presentation, even assign it to a toolbar button,
then open each of the other presentations, click the button, then save.
 
That set me to doing something I've been meaning to toss up here for a while
anyhow:

This is a very simple-minded approach you can use to run quick 'n dirty
macros on every presentation in a folder.

You need to edit the FolderPath and FileSpec lines in ForEachPresentation
below before you use this.
Then edit MyMacro do do whatever you need it to do.
MyMacro will be called for each file in FolderPath that matches FileSpec

Sub ForEachPresentation()
' 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

' EDIT THESE to suit your situation
FolderPath = "c:\some\folder\" ' Note: MUST end in \
FileSpec = "*.ppt"
' END OF EDITS

' 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 MyMacro(rayFileList(x))
Next x
End If

End Sub

Sub MyMacro(strMyFile 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

' do something here - this is where you'd insert the code you want
to run
' on each presentation

End With

oPresentation.Save
oPresentation.Close

End Sub
 
Back
Top