I
Iorav Marz
Hello,
I need to write some VBA code to continue tables that extend into the footer
table on successive slide(s). The code should go through all slides in the
PowerPoint file and:
1) Identify the first table that extends into or past the footer area of
the slide (below the 6.85" vertical position)
2) Insert a duplicate slide after the slide that contains this "extra-long"
table; this duplicate slide becomes a "continued" slide
3) Cut off the excessive rows in the "extra-long" table
4) Cut off the duplicate rows in the "continued" slide
5) Repeat for all extra-long tables in the PowerPoint file
I found some sample code that could prove useful under MSKB 240189; this
however does not apply for tables. Any ideas would be very much
appreciated... this is a time-consuming manual task that I hope can be
automated.
Sub ExpandSlide()
' Enable the error handler.
'
On Error GoTo ErrorHandler
Dim oShape As Shape
Dim i As Long
Dim oSlide As Slide
Dim strTitle As String
Dim lStrLen As Long
Dim lParas As Long
Dim lCurrIndex As Long
Dim lLastSlide As Long
Dim ErrMsg As String
' Check to see if the presentation is in the correct view.
' Raise the custom error message 555.
'
If ActiveWindow.ViewType <> ppViewNormal And ActiveWindow.ViewType _
<> ppViewSlide Then
Err.Raise 555, "Expand Slide Macro", _
"Not in Slide View or Normal View"
End If
With ActiveWindow.Selection
' Set lCurrIndex to the current slide index.
' Set lLastslide to the current slide index.
'
lCurrIndex = .SlideRange.SlideIndex
lLastSlide = lCurrIndex
' Check each shape of the current slide; check to
' see if it is a Body placeholder.
'
For Each oShape In .SlideRange.Shapes
If oShape.PlaceholderFormat.Type = ppPlaceholderBody Then
' Set lParas to the number of paragraphs in the
' Body placeholder. Does not differentiate between
' first level bullets and lower level bullets.
'
lParas = oShape.TextFrame.TextRange.Paragraphs.Count
For i = 1 To lParas
' Set strTitle to the current paragraph index.
'
strTitle = oShape.TextFrame.TextRange.Paragraphs(i).Text
' Determine how long the string is. Then, as long as
' it is not the last parapgraph in the Body placeholder,
' strip off the last two characters, the line feed and
' carriage return.
'
lStrLen = Len(strTitle)
If lParas <> i Then
strTitle = Left(strTitle, lStrLen - 2)
End If
' Set lLastSlide to the next available index position.
' Create a news slide, with the Bulleted Text layout.
' Assign the text from the current paragraph to the
' title placeholder. Return to the original slide.
'
lLastSlide = lLastSlide + 1
Set oSlide = _
ActivePresentation.Slides.Add(lLastSlide, ppLayoutText)
oSlide.Shapes(1).TextFrame.TextRange.Text = strTitle
ActiveWindow.View.GotoSlide (lCurrIndex)
Next i
End If
Next
End With
Exit Sub
ErrorHandler:
' Create Error message and raise dialog with error message.
'
ErrMsg = "Error:" & Err.Source & vbNewLine & Err.Description
MsgBox ErrMsg, vbCritical, "Error Message"
End Sub
I need to write some VBA code to continue tables that extend into the footer
table on successive slide(s). The code should go through all slides in the
PowerPoint file and:
1) Identify the first table that extends into or past the footer area of
the slide (below the 6.85" vertical position)
2) Insert a duplicate slide after the slide that contains this "extra-long"
table; this duplicate slide becomes a "continued" slide
3) Cut off the excessive rows in the "extra-long" table
4) Cut off the duplicate rows in the "continued" slide
5) Repeat for all extra-long tables in the PowerPoint file
I found some sample code that could prove useful under MSKB 240189; this
however does not apply for tables. Any ideas would be very much
appreciated... this is a time-consuming manual task that I hope can be
automated.
Sub ExpandSlide()
' Enable the error handler.
'
On Error GoTo ErrorHandler
Dim oShape As Shape
Dim i As Long
Dim oSlide As Slide
Dim strTitle As String
Dim lStrLen As Long
Dim lParas As Long
Dim lCurrIndex As Long
Dim lLastSlide As Long
Dim ErrMsg As String
' Check to see if the presentation is in the correct view.
' Raise the custom error message 555.
'
If ActiveWindow.ViewType <> ppViewNormal And ActiveWindow.ViewType _
<> ppViewSlide Then
Err.Raise 555, "Expand Slide Macro", _
"Not in Slide View or Normal View"
End If
With ActiveWindow.Selection
' Set lCurrIndex to the current slide index.
' Set lLastslide to the current slide index.
'
lCurrIndex = .SlideRange.SlideIndex
lLastSlide = lCurrIndex
' Check each shape of the current slide; check to
' see if it is a Body placeholder.
'
For Each oShape In .SlideRange.Shapes
If oShape.PlaceholderFormat.Type = ppPlaceholderBody Then
' Set lParas to the number of paragraphs in the
' Body placeholder. Does not differentiate between
' first level bullets and lower level bullets.
'
lParas = oShape.TextFrame.TextRange.Paragraphs.Count
For i = 1 To lParas
' Set strTitle to the current paragraph index.
'
strTitle = oShape.TextFrame.TextRange.Paragraphs(i).Text
' Determine how long the string is. Then, as long as
' it is not the last parapgraph in the Body placeholder,
' strip off the last two characters, the line feed and
' carriage return.
'
lStrLen = Len(strTitle)
If lParas <> i Then
strTitle = Left(strTitle, lStrLen - 2)
End If
' Set lLastSlide to the next available index position.
' Create a news slide, with the Bulleted Text layout.
' Assign the text from the current paragraph to the
' title placeholder. Return to the original slide.
'
lLastSlide = lLastSlide + 1
Set oSlide = _
ActivePresentation.Slides.Add(lLastSlide, ppLayoutText)
oSlide.Shapes(1).TextFrame.TextRange.Text = strTitle
ActiveWindow.View.GotoSlide (lCurrIndex)
Next i
End If
Next
End With
Exit Sub
ErrorHandler:
' Create Error message and raise dialog with error message.
'
ErrMsg = "Error:" & Err.Source & vbNewLine & Err.Description
MsgBox ErrMsg, vbCritical, "Error Message"
End Sub