Getting started with VBA in Powerpoint - editing existing text on slides

[cejhoney]

Hi everyone,

I'm just getting started with VBA in Powerpoint, after many years of using/editing VBA in Excel.
I was hoping that I could record a macro to get started, but have been disappointed to discover this facility is not available in Powerpoint.

Therefore, could I please ask for some help getting started - these are the initial things I'd like to do:


On opening file, ask for a date (eg 08 January 2015)
Insert date value on slide 1 (TitleSlideLayout, in subtitle placeholder)
:idea: Can I use 'fields' to mark the place I want the text, and assign the value entered as the value of the field? I think I've done this in Word before...
Using entered date, calculate ppt report dates which are a 12 month period of completed months (eg January 2014 - December 2015)
Using my previous VBA knowledge, I should be able to do this successfully.
Insert this text in headers on various slides, overwriting previous text. THIS WOULD NOT BE THE ONLY TEXT IN THE HEADERS.
:idea: Again, can I use fields to mark the place I want this text to make replacing previous text simpler?

Ultimately, I want to copy a load of data / graphs from Excel to populate the presentation, but I can see there are other questions/answers on here to help me with that so I'll read those first.

Thanks for any help you can give me to get started.
By the way, I'm using PowerPoint 2013.

Claire

[John Wilson]

Claire

Sadly you are going to be disappointed.

PPT vba is much more restrictive than Word or Excel and in particular there are no events easily available like Workbook_Open and Fields are not supported.

If you are opening the file in edit view you might want to look at our workaround here. (http://www.pptalchemy.co.uk/PowerPoint_Auto_Open_Code.html)

[Paul_Hossler]

As a possible very crude workaround, it might be possible to create a template with placeholders (kind of like Word's fields) and run a Find & Replace macro to replace the text with results of your macro's calculations for each 'field'

It would 'fix' the values so you'd have to go back to the general template if there are changes

Example:

##SOY## and ##EOY## could be embedded in the template as text, and your macro could ask for a 'As Of' date (1/11/2015) and compute a Start of Year date (1/1/2015) and then replace all ##SOY## with "Jan 1, 2015"


Ugly

[cejhoney]

Thanks John and Paul. I thought I might be disappointed as I read up a bit more over the weekend.
However, I suppose it doesn't need to run automatically when opened - i could start it myself.
Paul, I like your idea of a find & replace macro - think I'll experiment a bit with this.
Thanks guys
Claire

[John Wilson]

Shyam has published a nice search / replace macro. (http://skp.mvps.org/ppt00025.htm#2)

[cejhoney]

Thanks John - that saves me some time!

[Paul_Hossler]

One thing I've learned from John here is that PP is NOT like Excel

This is an extract of what I use if you want a starting point. I added two tags (##SOY##) as an example. If you're familiar with Excel VBA you can follow the code, although the PP object model is very different.

Here's a small PPTM if you want to play with it. Save it and remove the .zip since you cannot load .pptm files

No promises that this is the best or the only way to do it



Option Explicit
Const cModule As String = "StandardReplace"

Sub StandardReplace()
Dim dtStart As Date, dtEnd As Date

If NoPresentation Then Exit Sub
'ask user
If MsgBox("Do you want to do a standard replace in " & ActivePresentation.Name & "?", vbOKCancel + vbQuestion, cModule) = vbCancel Then Exit Sub


dtStart = DateSerial(Year(Now), 1, 1)
dtEnd = DateSerial(Year(Now), 12, 31)


On Error Resume Next
Call pvtReplaceTextAll("##SOY##", Format(dtStart, "mmmm yyyy"), False)
Call pvtReplaceTextAll("##EOY##", Format(dtEnd, "mmmm yyyy"), False)

Call MsgBox("Completed text cleaning in " & ActivePresentation.Name, vbInformation + vbOKOnly, cModule)
End Sub
Private Sub pvtReplaceTextAll(sOld As String, sNew As String, Optional bWholeWord As Boolean = False)

Dim oSlide As Slide
Dim oShape As Shape
Dim oText As TextRange
Dim oTemp As TextRange

On Error Resume Next

For Each oSlide In ActivePresentation.Slides
For Each oShape In oSlide.Shapes
Call pvtReplaceTextShape(oShape, sOld, sNew, bWholeWord)
Next oShape

Next oSlide
End Sub

Private Sub pvtReplaceTextShape(oShape As Object, FindString As String, ReplaceString As String, Optional bWholeWord As Boolean = False)
Dim oText As TextRange
Dim oTemp As TextRange
Dim i As Long, iRows As Long, iCols As Integer
Dim oShapeTmp As Shape

On Error Resume Next

Select Case oShape.Type

Case msoTable
For iRows = 1 To oShape.Table.Rows.Count
For iCols = 1 To oShape.Table.Rows(iRows).Cells.Count
Set oShapeTmp = oShape.Table.Rows(iRows).Cells(iCols).Shape
Call pvtReplaceTextShape(oShapeTmp, FindString, ReplaceString)
Next
Next

Case msoGroup 'Groups may contain shapes with text, so look within it
For i = 1 To oShape.GroupItems.Count
Call pvtReplaceTextShape(oShape.GroupItems(i), FindString, ReplaceString)
Next i

Case msoDiagram
For i = 1 To oShape.Diagram.Nodes.Count
Call pvtReplaceTextShape(oShape.Diagram.Nodes(i).TextShape, FindString, ReplaceString)
Next i

Case msoPlaceholder
If oShape.HasTable Then
For iRows = 1 To oShape.Table.Rows.Count
For iCols = 1 To oShape.Table.Rows(iRows).Cells.Count
Set oShapeTmp = oShape.Table.Rows(iRows).Cells(iCols).Shape
Set oText = oShapeTmp.TextFrame.TextRange
Set oTemp = oText.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, WholeWords:=bWholeWord)
Do While Not oTemp Is Nothing
Set oTemp = oText.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, WholeWords:=bWholeWord)
Loop
Next
Next

ElseIf oShape.HasTextFrame Then
If oShape.TextFrame.HasText Then
Set oText = oShape.TextFrame.TextRange
Set oTemp = oText.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, WholeWords:=bWholeWord)
Do While Not oTemp Is Nothing
Set oTemp = oText.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, WholeWords:=bWholeWord)
Loop

For i = 1 To oShape.TextFrame.TextRange.Paragraphs.Count
Set oText = oShape.TextFrame.TextRange.Paragraphs(i)
oText.Text = Trim(oText.Text)
oText.Characters(1, 1) = UCase(oText.Characters(1, 1))
Next i
End If
End If

Case Else
If oShape.HasTextFrame Then
If oShape.TextFrame.HasText Then
Set oText = oShape.TextFrame.TextRange
Set oTemp = oText.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, WholeWords:=bWholeWord)
Do While Not oTemp Is Nothing
Set oTemp = oText.Replace(FindWhat:=FindString, Replacewhat:=ReplaceString, WholeWords:=bWholeWord)
Loop

For i = 1 To oShape.TextFrame.TextRange.Paragraphs.Count
Set oText = oShape.TextFrame.TextRange.Paragraphs(i)
oText.Text = Trim(oText.Text)
oText.Characters(1, 1) = UCase(oText.Characters(1, 1))
Next i
End If
End If
End Select
End Sub
Public Function NoPresentation(Optional AtLeastThisManySlides As Long = 1) As Boolean
Const sModule As String = "NoPresentation"

NoPresentation = True

If Int(Val(Application.Version)) < 11 Then
Call MsgBox("This works only with PowerPoint 2003 or higher", vbInformation + vbOKOnly, sModule)
Exit Function
ElseIf Application.Presentations.Count = 0 Then
Call MsgBox("There is no Active Presentation. You have to create or open one before you can do this", vbInformation + vbOKOnly, sModule)
Exit Function
ElseIf ActivePresentation.Slides.Count < AtLeastThisManySlides Then
Call MsgBox("While there is an Active Presentation, there are less than " & AtLeastThisManySlides & " slides in it. You have to Insert Slides before you can do this", vbInformation + vbOKOnly, sModule)
Exit Function
Else
NoPresentation = False
End If
End Function

[Paul_Hossler]

Shyam has published a nice search / replace macro. (http://skp.mvps.org/ppt00025.htm#2)

Also thanks

I had based mine on a lot of the things he did a long while ago and forgot where I had gotten it.