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! : pray2::bow:

[dor1angray]

I understand this may take a bit of time to put together :dau:
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.:friends:

Thanks again!: pray2:

[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.:think:

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




: pray2:A humble genius you are, John Wilson:wot
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!"

:giggleThat's a good one! :yesSome of us are quite ingenious indeed...:king:

[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