Want to replace the text across a presentation?

That’s exactly what LinkedIn member Kerri recently wanted to do so we put on our thinking caps to come up with a solution.

I have a selection of slides I would like to use in a portfolio, but as the text is confidential, I would like to make it illegible – i have seen presentations where the text has been converted into something that looks like Latin – Does anyone please know how I can do this?

The Solution

The VBA macro at the end of this post can be used freely (without warranty) to replace all visible text across a presentation. This is what it does:

1. For every visible slide, it looks at every visible object on that slide, including placeholders, text boxes, shapes, tables, charts and groups.
2. If the object has text in it it then replaces each character in the text with sequenced characters from a pre-defined Lorem Ipsum string (which you can replace with something else if you want).
3. Once finished, it tells you how many characters were replaced across the presentation.
4. If you’re not happy with the result, you can just press Ctrl+Z to undo the changes.

Supported Objects

The macro has been updated and now supports the following:

*Note that SmartArt and certain chart features are not supported in this free version. Contact us if you’d like a fully feature add-in, accessible from the PowerPoint ribbon, complete with support and warranty.

Supported Platforms

The macro has been tested with some but not all of the configurations below.

PowerPoint : This macro will run on PowerPoint 2013, 2010, 2007 and 2011* for the Mac and supports both 32 and 64 bit versions of PowerPoint 2013 and 2010.

Windows OS : This macro will run under Microsoft Office on Windows 8, 7, Vista and XP (SP2) and supports both x86 and x64 versions.

*Mac OS : this macro will run on Mac OS X 10.4 and above with modification to the chart features.

How To Use

To add our ReplaceTextWithLorem macro, follow these steps:

1. Open the presentation in which you want to change the fonts to use your theme
2. Press Alt+F11 to open the VBE (Visual Basic Editor)*
3. Right click on your presentation (you should see it in the top left of the VBE)
4. Hover over Insert and then click Module
5. Copy the macro code at the end of this post into the module window:
   
6. Close the VBE window
7. Back in your presentation, press Alt+F8 and you will see a window containing the macro which you can select before clicking Run:
   
8. This will then remind you what you’re about to do and give you the option to cancel:
   

*You may also want to enable the Developer tab in the PowerPoint ribbon if you can’t see it as it adds all the VBA tools you need.

Result

Here’s a before and after view of the downloadable sample deck, which includes the macro:

License

The code is provided at no cost under the terms of the Creative Commons Attribution license which means you must attribute the work to us. You may do this on one of two ways:

1. Copy the code below and include the opening copyright section comments
2. Include the following text and link on at least one slide within your presentation and/or web page where the content resides:Macro design from youpresent.co.uk by GMARK

The All Important Macro

You can copy the code directly from below, download the macro in its purest text form or download the sample presentation corresponding to the screenshot above, which includes the macro within the file:

Download PowerPoint Sample Presentation

'---------------------------------------------------------------------
' Copyright (c) 2013 YOUpresent Ltd.
'
' Macro to replace all text in supported shapes* across a presentation
' with Lorem Ipsum text.
'
' Processes all visible shapes on all visible slides.
'
' Supported shapes:
' - Textboxes
' - Shapes (rectangles, circles, freeform etc.)
' - Placeholders (excluding slide numbers)
' - Tables
' - Charts (chart/axes titles and data point text only, legend is hidden, axes values have to be changed in the source data)
'
' Unsupported shapes:
' - SmartArt
'
' Written By : Jamie Garroch
' Date : 11th November 2013
' Website : http://youpresent.co.uk and http://www.gmark.co
'
'---------------------------------------------------------------------

Option Explicit

' Start of module level definitions
Private Const loremDefault = "Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Maecenas porttitor congue massa. " & _
	"Fusce posuere, magna sed pulvinar ultricies, purus lectus malesuada libero, sit amet commodo magna eros quis urna. " & _
	"Nunc viverra imperdiet enim. Fusce est. Vivamus a tellus. " & _
	"Pellentesque habitant morbi tristique senectus et netus et malesuada fames ac turpis egestas. Proin pharetra nonummy pede. Mauris et orci."
Private lorem As String
Private curSlide As Integer
Private counter As Single
Private Const MSG_STATUS = "GMARK_Status_Message"
Private restartLorum As VbMsgBoxResult
Private loremCounter As Integer
' End of module level definitions

Public Sub ReplaceTextWithLorem()

	On Error GoTo errorhandler

	Dim response
	Dim osld As Slide
	Dim oshp As Shape
	Dim ogrp As Shape
	Dim oRefresh As Shape

	' Get a reference to the current slide
	curSlide = ActiveWindow.View.Slide.SlideIndex

	' Add a temporary message to the current slide
	AddStatusMessage

	response = MsgBox("This macro replaces text across a presentation with Lorem Ipsum text." & Chr(13) & Chr(13) & _
	"It processes the following:" & Chr(13) & Chr(13) & _
	" - All visible slides" & Chr(13) & _
	" - All visible shapes (including placeholders, but not slide numbers)" & Chr(13) & _
	" - All visible groups" & Chr(13) & _
	" - All visible tables" & Chr(13) & _
	" - All visible charts (chart/axes titles and data point text only, legend is hidden, axes values have to be changed in the source data)" & Chr(13) & Chr(13) & _
	"It is not designed to change SmartArt or Pictures.", _
	vbOKCancel + vbInformation, "GMARK Macro : Lorem Ipsum by youpresent.co.uk")
	If response = vbCancel Then
		DeleteStatusMessage
		Exit Sub
	End If

	restartLorum = MsgBox("Do you want to restart the Lorum text substitution with each new shape that is found?", _
		vbYesNo + vbQuestion, "How do you want to process the text?")

	lorem = InputBox("Change the default substitution text if required:", "Substitution Text", loremDefault)
	If lorem = "" Then
		MsgBox "The substitution text cannot be empty!", vbOKOnly + vbCritical, "Stopping..."
		Exit Sub
	End If

	counter = 0

	For Each osld In ActivePresentation.Slides
		ActiveWindow.View.GotoSlide osld.SlideIndex
		DoEvents
		' If the slide is visible, process it
		If osld.SlideShowTransition.Hidden = msoFalse Then
			For Each oshp In osld.Shapes
				' If the shape is visible, process it
				If oshp.Visible = msoTrue Then
					'oshp.Select msoTrue
					'DoEvents
					Select Case oshp.Type
						Case msoGroup
							For Each ogrp In oshp.GroupItems
								SwapCharacters ogrp
							Next
						Case msoPlaceholder
							If Not oshp.PlaceholderFormat.Type = ppPlaceholderSlideNumber Then
								If oshp.HasChart Then ProcessChart oshp.Chart, oshp.Parent.SlideIndex
								'If oshp.HasSmartArt Then
								If oshp.HasTable Then ProcessTable oshp
								If oshp.HasTextFrame Then SwapCharacters oshp
							End If
						Case msoTable
							ProcessTable oshp
						Case msoChart
							ProcessChart oshp.Chart, oshp.Parent.SlideIndex
						Case Else
							SwapCharacters oshp
					End Select
				End If
				' Delete/comment out the next 3 lines to speed things up but remove on-screen viewing of changes
				If osld.SlideIndex > 1 Then ActiveWindow.View.GotoSlide osld.SlideIndex - 1
				ActiveWindow.View.GotoSlide osld.SlideIndex
				DoEvents
			Next
		End If
	Next

	DeleteStatusMessage

	MsgBox counter & " characters have been replaced across this presentation." & Chr(13) & Chr(13) & _
		"Click OK and check the result. Press Ctrl+Z to revert the changes.", vbOKOnly + vbInformation, "Finished!"
	Exit Sub

errorhandler:
	response = MsgBox("Uh oh. There was an unexpected error. with:" & Chr(13) & Chr(13) & _
		"Slide : " & oshp.Parent.SlideIndex & Chr(13) & _
		"Shape : " & oshp.Name & Chr(13) & Chr(13) & _
		"Ignore this error?" & Chr(13) & Chr(13) & _
		"Error : " & Err.Number & ", " & Err.Description, vbYesNo + vbCritical, "Macro Error")
	If response = vbYes Then
	Resume Next
Else
	DeleteStatusMessage
End If

End Sub

Private Sub ProcessTable(oshp As Shape)
	Dim lRow As Long, lCol As Long
	Dim oCellShp As Shape
	With oshp.Table
		For lRow = 1 To .Rows.Count
			For lCol = 1 To .Columns.Count
				SwapCharacters .Cell(lRow, lCol).Shape, True, "[R:" & CStr(lRow) & ", C:" & CStr(lCol) & "]"
			Next
		Next
	End With
End Sub

Private Sub ProcessChart(oChart As Chart, Optional ParentSlideIndex As Integer)
	Dim oSeries As Object 'Series
	Dim oDataPoint As Object 'Point
	Dim oAxis As Object  'Axis
	' Number of series : oChart.SeriesCollection.Count
	' Number of data points : oChart.SeriesCollection(1).Points.Count
	' Point HasDataLabel : oChart.SeriesCollection(1).Points(1).HasDataLabel
	' Point Data Label : oChart.SeriesCollection(1).Points(1).DataLabel.Text
	With oChart
		' Process the chart title if it exists
		If .HasTitle Then .ChartTitle.text = SwapText(.ChartTitle.text, ParentSlideIndex)

		' Process the axes title text if any exists
		For Each oAxis In .Axes
			' .Axes(xlCategory, xlPrimary).HasTitle
			' .Axes(xlValue, xlPrimary).HasTitle
			If oAxis.HasTitle Then oAxis.AxisTitle.text = SwapText(oAxis.AxisTitle.text, ParentSlideIndex)
		Next
		' Process the axes category text if any exists
		' -> Can't do this without changing the data

		' Process the legend text if any exists
		' -> Can't do this without changing the data so just hide it
		If .HasLegend Then .HasLegend = False

		' Process the data label text if any exists
		For Each oSeries In oChart.SeriesCollection
			For Each oDataPoint In oSeries.Points
				With oDataPoint
					If .HasDataLabel Then .DataLabel.text = SwapText(.DataLabel.text, ParentSlideIndex)
				End With
			Next
		Next
	End With
End Sub

Private Function SwapText(text As String, Optional ParentSlideIndex As Integer) As String
	Dim sourceChar As Integer
	Dim newChar As Integer
	For sourceChar = 1 To Len(text)
		If restartLorum = vbNo Then loremCounter = loremCounter + 1
		If loremCounter > Len(lorem) Then loremCounter = 1
		newChar = IIf(restartLorum = vbYes, sourceChar Mod (Len(lorem) + 1), loremCounter)
		If newChar = 0 Then newChar = 1
		' Spew out the characters in the VBE immediate window (Ctrl+G) for debugging
		Debug.Print Mid(text, sourceChar, 1) & ":" & AscW(Mid(text, sourceChar, 1)) & "->"; Mid(lorem, newChar, 1) & _
			" from slide:" & ParentSlideIndex & ", shape:" & "Chart"
		' Replace the character
		Mid(text, sourceChar, 1) = Mid(lorem, newChar, 1)
		counter = counter + 1
	Next
	SwapText = text
End Function

Private Sub SwapCharacters(swapShp As Shape, Optional shapeTypeCell As Boolean, Optional tableCellRef As String)
	Dim sourceChar As Integer
	Dim newChar As Integer
	Dim shpRef As String

	' Skip the name check as table cells don't support this shape method
	If shapeTypeCell = True Then GoTo skipNameCheck
	' If the non-table-cell shapes is not the status message shape, process it
	If swapShp.Name = MSG_STATUS Then Exit Sub

skipNameCheck:
	With swapShp
		' If the shape has a text frame, process it
		If .HasTextFrame Then
			With .TextFrame
				' If the textframe has text, process it
				If .HasText Then
					With .TextRange
						' Loop through the text, searching each character individually
						For sourceChar = 1 To Len(.text)
							If restartLorum = vbNo Then loremCounter = loremCounter + 1
							If loremCounter > Len(lorem) Then loremCounter = 1
							newChar = IIf(restartLorum = vbYes, sourceChar Mod (Len(lorem) + 1), loremCounter)
							If newChar = 0 Then newChar = 1
							Select Case AscW(.Characters(sourceChar, 1))
								' Don't replace non-printable characters
								Case 9, 10, 11, 13 ' TAB, CR, LF, VTAB
									' Do nothing
									Debug.Print AscW(.Characters(sourceChar, 1))
								Case Else
									' Spew out the characters in the VBE immediate window (Ctrl+G) for debugging
									If shapeTypeCell = True Then shpRef = tableCellRef Else shpRef = swapShp.Name
									Debug.Print .Characters(sourceChar, 1) & ":" & AscW(.Characters(sourceChar, 1)) & "->"; Mid(lorem, newChar, 1) & _
									" from slide:" & swapShp.Parent.SlideIndex & ", shape:" & shpRef
									' Replace the character
									.Characters(sourceChar, 1) = Mid(lorem, newChar, 1)
									counter = counter + 1
							End Select
						Next
					End With
				End If
			End With
		End If
	End With
End Sub

Private Sub AddStatusMessage()
	Dim slideWidth As Integer
	Dim slideHeight As Integer
	Dim msgShape As Shape
	On Error Resume Next
	slideWidth = ActivePresentation.PageSetup.slideWidth
	slideHeight = ActivePresentation.PageSetup.slideHeight
	With ActivePresentation.Slides(curSlide).Shapes
		Set msgShape = .AddShape(msoShapeRectangle, 0, 0, slideWidth, slideHeight)
		With msgShape
			.Name = MSG_STATUS
			.Fill.Visible = msoTrue
			.Fill.ForeColor.RGB = RGB(0, 0, 0)
			.Fill.Transparency = 0.3
			With .TextFrame.TextRange
				.text = "processing shapes..." & Chr(13) & Chr(13) & "(may take a LONG time)"
				With .Font
					.Name = "Calibri"
					.Size = 60
					.Color.RGB = RGB(255, 255, 255)
				End With
			End With
		End With
	End With
	ActiveWindow.ViewType = ppViewNormal
	ActiveWindow.View.GotoSlide curSlide
	DoEvents
End Sub

Private Sub DeleteStatusMessage()
	On Error Resume Next
	ActivePresentation.Slides(curSlide).Shapes(MSG_STATUS).Delete
	loremCounter = 0
	ActiveWindow.View.GotoSlide curSlide
End Sub