Replace all text with XXXX

jg9619 · #1 10-24-2013, 08:54 AM

I work in a company with a lot of secure data, however we like to leverage powerpoint templates etc...

Does anyone have a macro code that would be able to replace all of the text on a powerpoint slide with XXXX. This way we could use the format, but have the data cleaned and sanitized from the pages.

Thanks!

excelledsoftware · #2 10-25-2013, 05:04 PM

Quote:

Originally Posted by jg9619

I work in a company with a lot of secure data, however we like to leverage powerpoint templates etc...

Does anyone have a macro code that would be able to replace all of the text on a powerpoint slide with XXXX. This way we could use the format, but have the data cleaned and sanitized from the pages.

Thanks!

Is all of the text in your presentation presented in text boxes or is some of it in autoshapes as well?

JohnWilson · #3 10-27-2013, 10:44 AM

It won'r make much difference to the code if the text is in textboxes, shapes or placeholders but it will if it's in tables, smart art or charts.

Also what does replace text with xxxx actually mean.

If the original was "This makes sense" would you expect "xxx" or "xxxx xxxxx xxxxx"??

jg9619 · #4 10-28-2013, 12:00 PM

Thanks for the replies!

@excelledsoftware: It could be either of those.

@JohnWilson: You're correct in the second example. After a little bit of research I found that since PowerPoint doesn't use an upgraded search like Word, the simple functionality of using wildcards doesn't work.

I would like to replace each character with an X, thus preserving the format but deleting the data.

Thanks for the help!

JohnWilson · #5 10-29-2013, 08:37 AM

You could start with something like this. Probably will need a little work so use a copy!

Code:

Sub Obfuscate()
    Dim osld   As Slide
    Dim oshp   As Shape
    Dim iRow   As Integer
    Dim iCol   As Integer
    Dim wrd    As Long
    Dim otxTemp As TextRange

    For Each osld In ActivePresentation.Slides
        For Each oshp In osld.Shapes
            If oshp.HasTable Then
                For iRow = 1 To oshp.Table.Rows.Count
                    For iCol = 1 To oshp.Table.Columns.Count
                        If oshp.Table.Cell(iRow, iCol).Shape.HasTextFrame Then
                            If oshp.Table.Cell(iRow, iCol).Shape.TextFrame.HasText Then
                                Set otxTemp = oshp.Table.Cell(iRow, iCol).Shape.TextFrame.TextRange
                                For wrd = 1 To otxTemp.Words.Count
                                    otxTemp.Words(wrd) = String$(Len(Trim(otxTemp.Words(wrd))), "*") & " "
                                    Next wrd
                            End If
                        End If
                    Next iCol
                Next iRow
            Else
                If oshp.HasTextFrame Then
                    If oshp.TextFrame.HasText Then
                        Set otxTemp = oshp.TextFrame.TextRange
                        For wrd = 1 To otxTemp.Words.Count
                            otxTemp.Words(wrd) = String$(Len(Trim(otxTemp.Words(wrd))), "*") & " "
                        Next wrd
                    End If
                End If
            End If
        Next oshp
    Next osld
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Replace text in multiple documents?	Roscoe	Word VBA	7	07-31-2017 04:02 PM
Macro to find text and replace with form field containing that text	iiiiifffff	Word VBA	16	06-04-2016 01:47 AM
find and replace text Outlook VBA help	switchup621	Outlook	1	08-13-2013 10:05 AM
How to replace text with [] around it?	Barcode	Word	4	04-04-2013 03:09 AM
Replace formatting with text	eyehefbee	Word	2	11-09-2009 02:41 AM