Delete Empty Paragraphs in Notes Body Placeholder

[caten]

I'm trying to loop through all notes pages and remove empty paragraphs
(extraneous returns usually at the end of a block of text). I can't seem to
identify an empty paragraph. I tried .Text = "" and .Text = " " (a single
space) and .Text = VbCrLf, but none of those worked. I also tried the
characters for a paragraph break (Chr$13 and Chr$(13) & Chr$(10), found at
pptfaq.com) but no luck there either. I tried If Not .HasText, but that
didn't do it. I'm stumped. Any ideas?


Sub DeleteEmptyParagraphs()

Dim oPres As Presentation
Dim oSl As Slide
Dim oNotesBox As Shape
Dim X As Long ' NotesPage Shape "oNotesBox"
Dim i As Long ' Paragraph
Set oPres = ActivePresentation

'On Error Resume Next

For Each oSl In oPres.Slides
With oSl
For X = 1 To oSl.NotesPage.Shapes.Count
If .NotesPage.Shapes(X).Type = msoPlaceholder Then
' The shape is a placeholder
If .NotesPage.Shapes(X).PlaceholderFormat.Type =
ppPlaceholderBody Then
' The shape is a body placeholder
Set oNotesBox = .NotesPage.Shapes(X)
With oNotesBox
For i = 1 To
oNotesBox.TextFrame.TextRange.Paragraphs.Count
If oNotesBox.TextFrame.TextRange.Text = ""
Then '''
oNotesBox.TextFrame.TextRange.Delete
End If
Next 'i Paragraph
End With
End If ' The shape is not a PlaceholderBody
End If ' The shape is not an msoPlaceholder
Next 'X oNotesBox
End With 'oSl
Next ' oSl
End Sub

I'd appreciate any suggestions.

 

[John Wilson]

As well as the above you cannot loop through shapes deleting shapes as you
go. (I'm sure I learned this from Steve!) Also you need to specify it's the
paragraph you are checking and deleting NOT the whole textrange

Try looping in reverse see if that works.

Sub DeleteEmptyParagraphs()

Dim oPres As Presentation
Dim oSl As Slide
Dim oNotesBox As Shape
Dim X As Long ' NotesPage Shape "oNotesBox"
Dim i As Long ' Paragraph
Set oPres = ActivePresentation
For Each oSl In oPres.Slides
With oSl
For X = 1 To oSl.NotesPage.Shapes.Count
If .NotesPage.Shapes(X).Type = msoPlaceholder Then
' The shape is a placeholder
If .NotesPage.Shapes(X).PlaceholderFormat _
..Type = ppPlaceholderBody Then
' The shape is a body placeholder
Set oNotesBox = .NotesPage.Shapes(X)

For i = oNotesBox.TextFrame _
..TextRange.Paragraphs.Count To 1 Step -1
With oNotesBox.TextFrame.TextRange.Paragraphs(i)
If .Text = vbCr & vbLf Then .Delete
End With
Next 'i Paragraph

End If ' The shape is not a PlaceholderBody
End If ' The shape is not an msoPlaceholder
Next 'X oNotesBox
End With 'oSl
Next ' oSl
End Sub

 

[caten]

Try using Replace on the the entire notes text box.textframe.text to replace
VbCrLf & VbCrLf with VbCrLf

Briliant! I know that when I get stumped I need to find another way to look
at things, use a different tool, take another approach. But I didn't think of
this one. Thank you for the suggestion.

Now, can you help me with implementation? With the code I have, all of the
empty paragraphs are "deleted" except for the last one, the last occurence of
the find/replace found text. Is my After parameter wrong?

Sub DeleteEmptyParagraphs()

Dim oPres As Presentation
Dim oSl As Slide
Dim oNotesBox As Shape
Dim X As Long ' NotesPage Shape "oNotesBox"
Dim i As Long ' Paragraph
Set oPres = ActivePresentation

For Each oSl In oPres.Slides
With oSl
For X = 1 To oSl.NotesPage.Shapes.Count
If .NotesPage.Shapes(X).Type = msoPlaceholder Then
' The shape is a placeholder
If .NotesPage.Shapes(X).PlaceholderFormat.Type =
ppPlaceholderBody Then
' The shape is a body placeholder
Set oNotesBox = .NotesPage.Shapes(X)
Set oTxtRng = oNotesBox.TextFrame.TextRange
oTxtRng.Select
Set oTmpRng = oTxtRng.Find(FindWhat:=vbCrLf & vbCrLf)
oTmpRng.Select
Do While Not oTmpRng Is Nothing
If Not oTmpRng.ParagraphFormat.Bullet Then
Set oTmpRng =
oTxtRng.Replace(FindWhat:=vbCrLf & vbCrLf, _
Replacewhat:=vbCrLf,
After:=oTmpRng.Start - 1)
'oTmpRng.Select 'use while debugging
End If
Set oTmpRng = oTxtRng.Find(FindWhat:=vbCrLf &
vbCrLf, _
After:=oTmpRng.Start
+ oTmpRng.Length)
Loop
End If ' The shape is not a PlaceholderBody
End If ' The shape is not an msoPlaceholder
Next 'X oNotesBox
End With 'oSl
Next ' oSl

End Sub