How to modify text in Powerpoint via Excel VBA without changing style

Question

I am trying to replace a set of tags in the text of a powerpoint slide from Excel using VBA. I can get the slide text as follows:

Dim txt as String
txt = pptSlide.Shapes(jj).TextFrame.TextRange.Characters.text

I then run through replacing my tags with the requested values. However when I set do

pptSlide.Shapes(jj).TextFrame.TextRange.Characters.text = txt

Problem: All the formatting which the user has set up in the text box is lost.

Background: The shape object is msoPlaceHolder and contains a range of text styles including bullet points with tags which should be replaced with numbers for instance. The VBA should be unaware of this formatting and need only concern itself with the text replacement.

Can anyone tell me on how to modify the text while keeping the style set up by the user.

Thanks.

Am using Office 2010 if that is helpful.

Could you give example of before-after-should be? you can do it with either screen shot or some text added to your question and formatted with HTML. One tip- Characters allows to set certain range to be replaced according to syntax Characters(start, length) which will keep formatting if text length 'before and after' are the same. — Kazimierz Jawor
– Kazimierz Jawor, Commented Aug 5, 2013 at 15:45
KazJaw pointed to the correct solution. Use Characters(start,length) to alter the text and the style which was allocated to the characters replaced will be give to the new characters. Thanks! — user1412028
– user1412028, Commented Aug 5, 2013 at 18:29
Use the Replace method of the text range to replace one string with another. This will preserve formatting to the extent possible, within limits. IIRC, if you have "Now is the time" with each word differently formatted and replace it with "That was the time", the new text will all assume the formatting of the first text in the range it replaced (ie, whatever "N" in Now was formatted as. — Steve Rindsberg
– Steve Rindsberg, Commented Aug 5, 2013 at 18:52

PJ_in_FL · Accepted Answer · 2015-12-17 01:04:47Z

The solution by Krause is close but the FIND method returns a TextRange object that has to be checked. Here is a complete subroutine that replaces FROM-string with TO-string in an entire presentation, and DOESN'T mess up the formatting!

Sub Replace_in_Shapes_and_Tables(pPPTFile As Presentation, sFromStr As String, sToStr As String)
    Dim sld         As Slide
    Dim shp         As Shape
    Dim i           As Long
    Dim j           As Long
    Dim m           As Long
    Dim trFoundText As TextRange

    On Error GoTo Replace_in_Shapes_and_Tables_Error

    For Each sld In pPPTFile.Slides
        For Each shp In sld.Shapes

            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then                   ' only perform action on shape if it contains the target string
                    Set trFoundText = shp.TextFrame.TextRange.Find(sFromStr)
                    If Not (trFoundText Is Nothing) Then
                        m = shp.TextFrame.TextRange.Find(sFromStr).Characters.Start
                        shp.TextFrame.TextRange.Characters(m).InsertBefore (sToStr)
                        shp.TextFrame.TextRange.Find(sFromStr).Delete
                    End If
                End If
            End If

            If shp.HasTable Then
                For i = 1 To shp.Table.Rows.Count
                    For j = 1 To shp.Table.Columns.Count

                        Set trFoundText = shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr)
                        If Not (trFoundText Is Nothing) Then
                            m = shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr).Characters.Start
                            shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Characters(m).InsertBefore (sToStr)
                            shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr).Delete
                        End If

                    Next j
                Next i
            End If

        Next shp
    Next sld


    For Each shp In pPPTFile.SlideMaster.Shapes
        If shp.HasTextFrame Then
            If shp.TextFrame.HasText Then
                Set trFoundText = shp.TextFrame.TextRange.Find(sFromStr)
                If Not (trFoundText Is Nothing) Then
                    m = shp.TextFrame.TextRange.Find(sFromStr).Characters.Start
                    shp.TextFrame.TextRange.Characters(m).InsertBefore (sToStr)
                    shp.TextFrame.TextRange.Find(sFromStr).Delete
                End If

            End If
        End If

        If shp.HasTable Then
            For i = 1 To shp.Table.Rows.Count
                For j = 1 To shp.Table.Columns.Count
                    Set trFoundText = shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr)
                    If Not (trFoundText Is Nothing) Then
                        m = shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr).Characters.Start
                        shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Characters(m).InsertBefore (sToStr)
                        shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr).Delete
                    End If

                Next j
            Next i
        End If
    Next shp

   On Error GoTo 0
   Exit Sub

Replace_in_Shapes_and_Tables_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Replace_in_Shapes_and_Tables of Module modA_Code"
    Resume

End Sub

I had to change the 'shp' to be initialized as an Object type instead of a Shape type to avoid a type mistmatch, but otherwise this worked perfectly!

E. Krause · Accepted Answer · 2014-11-13 16:22:49Z

While what Steve Rindsberg said is true I think I have come up with a decent workaround. It is by no means pretty but it gets the job done without sacrificing the formatting. It uses Find functions and Error Controlling for any text box that doesn't have the variable you are looking to change out.

i = 1

Set oPs = oPa.ActivePresentation.Slides(oPa.ActivePresentation.Slides.Count)

j = 1

Do Until i > oPa.ActivePresentation.Slides.Count

oPa.ActivePresentation.Slides(i).Select

Do Until j > oPa.ActivePresentation.Slides(i).Shapes.Count

    If oPa.ActivePresentation.Slides(i).Shapes(j).HasTextFrame Then
        If oPa.ActivePresentation.Slides(i).Shapes(j).TextFrame.HasText Then

            On Error GoTo Err1

            If oPa.ActivePresentation.Slides(i).Shapes(j).TextFrame.TextRange.Find("[specific search term]") = "[specific search term]" Then
                m = oPa.ActivePresentation.Slides(i).Shapes(j).TextFrame.TextRange.Find("[specific search term]").Characters.Start
                oPa.ActivePresentation.Slides(i).Shapes(j).TextFrame.TextRange.Characters(m).InsertBefore ([replace term])
                oPa.ActivePresentation.Slides(i).Shapes(j).TextFrame.TextRange.Find("[specific search term]").Delete
ExitHere:
            End If
        End If
    End If

    j = j + 1

Loop

j = 1

i = i + 1

Loop

Exit Sub

Err1:

Resume ExitHere

End Sub

Hope this helps!

Justin Henderson · Accepted Answer · 2016-09-17 20:50:20Z

I found the solution using the code below. It edits the notes by replacing "string to replace" with "new string". This example is not iterative and will only replace the first occurrence but it should be fairly easy to make it iterative.

$PowerpointFile = "C:\Users\username\Documents\test.pptx"
$Powerpoint = New-Object -ComObject powerpoint.application
$ppt = $Powerpoint.presentations.open($PowerpointFile, 2, $True, $False)
$ppt.Slides[3].Shapes[2].TextFrame.TextRange.Text
$ppt.Slides[3].NotesPage.Shapes[2].TextFrame.TextRange.Text
foreach($slide in $ppt.slides){
    $TextRange = $slide.NotesPage.Shapes[2].TextFrame.TextRange

    $find = $TextRange.Find('string to replace').Start
    $TextRange.Find('string to replace').Delete()
    $TextRange.Characters($find).InsertBefore('new string')

    $TextRange.Text
}

$ppt.SaveAs("C:\Users\username\Documents\test2.pptx")
$Powerpoint.Quit()

Collectives™ on Stack Overflow

How to modify text in Powerpoint via Excel VBA without changing style

3 Answers 3

1 Comment

Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

1 Comment

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related