Macros to Find/Replace Hard Returns in PPT

[dor1angray]

Dear experts,


I work for a localization company.
We deal with PPT/PPTX translation on the daily basis.
When translating those, we need to import them into one of those CAT software products.


Yet, here is where we start having issues. Segmentation rules make the CAT separate sentences from those PPTs into separate segments whenever - apart from all - there is a so-called hard return (carriage return/paragraph mark) which we cannot really see in PPTs


Sometimes we receive huge presentations from the client, with up to 200 slides.
And each slide has several shapes with text that is very often separated by those hard returns (e.g. imagine a star-shaped object with 'Clent <invisible paragraph mark> Feedback' text). In CAT those two words get separated into two different segments, which confuses translators making them think that those are 2 separate independent words, which is not correct.


So, to avoid this, we have to manually prep those files tripple-clicking each such shape with text.
If after this tripple-clicking we see that the text gets fully selected, this means we are good to go and there will be no segmentation issues.


But imagine a person doing this for a 200-pages PPTX with 10-15 text shapes in each of the slides.


Could you please help me out with 2 VBA scripts for PowerPoint to look for and delete (except for the bullet lists events) those single hard returns in all PPT objects throughout the file subbing them by


1) a space mark
2) soft return (this keeps the shape text layout, but lets CAT keep the text in a single segment)


Also, it would be very helpful if somewhere in the script there was a point where I could manually delimit a page range.


Your help will be truly appreciated!

[dor1angray]

I understand this may take a bit of time to put together
Whoever comes with a solution to this please PM me and I will reward the person with a humble $25 PayPal donation for a working script.

Thanks again!

[John Wilson]

The idea of help forums is to SHARE information so you shouldn't ask for private help (or offer payment in the forum)

This should get you on the right track.

Sub fixme()
Dim otxR As TextRange
Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If Not oshp.Type = msoPlaceholder Then
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
Set otxR = oshp.TextFrame.TextRange
otxR.Text = Replace(otxR.Text, Chr(13), Chr(11))
End If
End If
End If
Next oshp
Next osld
End Sub

[dor1angray]

After testing this one out for a while I discovered that by deleting hard returns this way in the shape that has e.g. a title that is bold and the color of which is orange that is followed by simply formatted text, the formatting of such segments get all messed up somehow. Now, however grateful I am for all your input and help I still need to ask another the question, John. I am wondering whether it is possible at all to keep the individual formatting some way avoiding quite a bit of a mess due to merging styles at the time of the macros application?

Sub LessParas()
  Dim aSlide As Slide
  Dim aShp As Shape
  
  For Each aSlide In ActivePresentation.Slides
    For Each aShp In aSlide.Shapes
      If aShp.HasTextFrame Then
        With aShp.TextFrame.TextRange
          If .ParagraphFormat.Bullet = msoFalse Then
            .Text = Replace(.Text, vbCr, " ")
          End If
        End With
      End If
    Next aShp
  Next aSlide
End Sub

The only idea that comes into my mind is to find a way to restrict the script application to only those segments that have similar color/size/font type so that the macros skipped such segments in the shapes - the way it is now skipping bulleted/numered lists.

I advanced quite a bit with VBA yet I still do not know if the above is possible. If you could confirm this, I would go ahead and try to elaborate the restricting Ifs for this.

Thanks in advance,
Ilia

[John Wilson]

Maybe something like this (use a copy in case it fails)

Sub fixme()   Dim otxR As TextRange2
   Dim otRtarget As TextRange2
   Dim osld As Slide
   Dim L As Long
   Dim C As Long
   Dim oshp As Shape
   On Error Resume Next
   For Each osld In ActivePresentation.Slides
      For Each oshp In osld.Shapes
         If Not oshp.Type = msoPlaceholder Then
            If oshp.HasTextFrame Then
               If oshp.TextFrame.HasText Then
                  For L = oshp.TextFrame2.TextRange.Paragraphs.Count To 1 Step -1
                     Set otxR = oshp.TextFrame2.TextRange.Paragraphs(L)
                     For C = 1 To otxR.Characters.Count
                        If Asc(otxR.Characters(C)) = 13 Then
                           otxR.InsertAfter Chr(11)
                           otxR.Characters(C).Delete
                        End If
                     Next
                  Next L
               End If
            End If
         End If
      Next oshp
   Next osld
End Sub

[dor1angray]

Maybe something like this (use a copy in case it fails)

Sub fixme()   Dim otxR As TextRange2
   Dim otRtarget As TextRange2
   Dim osld As Slide
   Dim L As Long
   Dim C As Long
   Dim oshp As Shape
   On Error Resume Next
   For Each osld In ActivePresentation.Slides
      For Each oshp In osld.Shapes
         If Not oshp.Type = msoPlaceholder Then
            If oshp.HasTextFrame Then
               If oshp.TextFrame.HasText Then
                  For L = oshp.TextFrame2.TextRange.Paragraphs.Count To 1 Step -1
                     Set otxR = oshp.TextFrame2.TextRange.Paragraphs(L)
                     For C = 1 To otxR.Characters.Count
                        If Asc(otxR.Characters(C)) = 13 Then
                           otxR.InsertAfter Chr(11)
                           otxR.Characters(C).Delete
                        End If
                     Next
                  Next L
               End If
            End If
         End If
      Next oshp
   Next osld
End Sub

Hello John,

I tested this one out and it worked fine for all types of shapes with text. Yet, when I tried to add If .ParagraphFormat.Bullet = msoFalse Then, I received a compilation error 'Invalid or unqualified reference'. At which point should I exclude bulleted lists? As a result of the macros they all become 1-item lists.

The initial macros did include the exclusion condition, yet I could not add it to the one that you wrote that keeps individual formatting of the items originally separated with hard returns.

Please let me know if this exclusion is possible for the macros above.

Thanks a bunch again,
Ilia

[John Wilson]

That won't be easy because once you start putting soft return before a bullet line the bullet will be removed.

Something like this might work but i don't have time right now to test properly.

Sub fixme()Dim otxR As TextRange2
    Dim otRtarget As TextRange2
    Dim osld As Slide
    Dim L As Long
    Dim C As Long
    Dim oshp As Shape
    On Error Resume Next
    For Each osld In ActivePresentation.Slides
        For Each oshp In osld.Shapes
            If Not oshp.Type = msoPlaceholder Then
                If oshp.HasTextFrame Then
                    If oshp.TextFrame.HasText Then
                        For L = oshp.TextFrame2.TextRange.Paragraphs.Count To 1 Step -1
                        If oshp.TextFrame2.TextRange.Paragraphs(L).ParagraphFormat.Bullet.Type = msoBulletNone And _
                        oshp.TextFrame2.TextRange.Paragraphs(L + 1).ParagraphFormat.Bullet.Type = msoBulletNone Then
                            Set otxR = oshp.TextFrame2.TextRange.Paragraphs(L)
                            For C = 1 To otxR.Characters.Count
                                If Asc(otxR.Characters(C)) = 13 Then
                                    otxR.InsertAfter Chr(11)
                                    otxR.Characters(C).Delete
                                End If
                            Next
                            End If
                        Next L
                    End If
                End If
            End If
        Next oshp
    Next osld
End Sub

[dor1angray]

That won't be easy because once you start putting soft return before a bullet line the bullet will be removed.

Something like this might work but i don't have time right now to test properly.

Sub fixme()Dim otxR As TextRange2
    Dim otRtarget As TextRange2
    Dim osld As Slide
    Dim L As Long
    Dim C As Long
    Dim oshp As Shape
    On Error Resume Next
    For Each osld In ActivePresentation.Slides
        For Each oshp In osld.Shapes
            If Not oshp.Type = msoPlaceholder Then
                If oshp.HasTextFrame Then
                    If oshp.TextFrame.HasText Then
                        For L = oshp.TextFrame2.TextRange.Paragraphs.Count To 1 Step -1
                        If oshp.TextFrame2.TextRange.Paragraphs(L).ParagraphFormat.Bullet.Type = msoBulletNone And _
                        oshp.TextFrame2.TextRange.Paragraphs(L + 1).ParagraphFormat.Bullet.Type = msoBulletNone Then
                            Set otxR = oshp.TextFrame2.TextRange.Paragraphs(L)
                            For C = 1 To otxR.Characters.Count
                                If Asc(otxR.Characters(C)) = 13 Then
                                    otxR.InsertAfter Chr(11)
                                    otxR.Characters(C).Delete
                                End If
                            Next
                            End If
                        Next L
                    End If
                End If
            End If
        Next oshp
    Next osld
End Sub

A humble genius you are, John Wilson
You always add a disclaimer that the script is untested and may be buggy, yet the code comes out simply flawless and works impeccably well. Thank you again and again!

[John Wilson]

In real life I code for a living and there I spend at least 3 times as long testing as writing. On this site I leave testing to you! We have a sign on the office wall - "You made the code FOOLPROOF? Did you consider the ingenuity of fools!"

[dor1angray]

In real life I code for a living and there I spend at least 3 times as long testing as writing. On this site I leave testing to you! We have a sign on the office wall - "You made the code FOOLPROOF? Did you consider the ingenuity of fools!"

That's a good one! Some of us are quite ingenious indeed...

[dor1angray]

Hi John,

Seems like it is skipping all grouped shapes with text. Tried to create a UngroupAllShapes macros but it does not seem to work at all though it should be super simple; not sure where the issue is. I have two options now: either get this UngroupAllShapes macros working and run it each time before the one that you came up with or modify the one that you devised to include grouped shapes or ungroup all shapes command before all the hard return replacing logic kicks in.

Any ideas what would be my best option?
Thanks, as always.

[John Wilson]

If oshp.Type=msoGroup

You would need to loop throup all of the GroupItems in the Group and check for them having a text frame etc.

You will have a similar problem with smart art and tables