Alternate row highlighting in text frame (PPT 2007)

[Dale Fye]

Working in a text frame, is there a way to highlight alternate rows to make
the data presented in the frame more legible?

I know I could use a table and "banded rows", but am building this text
frame via VBA, and would rather not have to deal with creating a table and
inserting data one line at a time into the table.

I also know I could play around with creating rectangles behind the
textframe, but would rather not do that either.

 

[John Wilson]

I'm not suggesting this is necessarily workable but it may help!

I was surprized to find that this works in 2007:

Dim otxR2 As TextRange2
'Shapes(3) is a textbox
Set otxR2 = ActivePresentation.Slides(1).Shapes(3).TextFrame2.TextRange
otxR2.Lines(1).Font.Highlight.RGB = vbYellow

and more surprized to find I can't unhighlight!

The only way to get back seems to be create a default textbox and use pickup
/ apply (or the format painter)

If you find a way let me know!

 

[Dale Fye]

John,

that is pretty cool, but unfortunately, it only highlights the text on those
lines.

It works well for one of the text frames I'm trying to highlight, which has
full sentences, but for the frame contains text on one side, a tab character,
and text all the way to the right, so I get white space between the text,
rather than a fully highlighted line.

I may have to go with building the rectangles and putting them in the
background.

Anybody got any example code for grouping multiple shapes and then pushing
them to the back?

 

[Dale Fye]

Ok, here is what I have so far. This works pretty well, except:

1. I still have not figured out how to group all of these shapes together
and push them behind the textframe.
2. The spacing is just a little bit off. My guess is that I need to adjust:
a. The initial Top setting. Right now it is lined up with the top of
the frame, but there appears to be an offset between the top of the frame and
the first line of text.
b. The height slightly of the multi line paragraphs. I'm not sure
what to look for here
3. Have not figured out how to turn off the borders (get rid of the lines
around the rectangles).

Public Sub HighlightTextFrame(oSlide as Powerpoint.Slide, _
oShape as Powerpoint.Shape)

Dim intLoop As Integer
Dim dblTop As Double, dblLeft As Double, dblWidth As Double
Dim dblHeight As Double

Dim oTxtRng As powerpoint.TextRange

Set oTxtRng = oShape.TextFrame.TextRange
dblTop = oShape.Top + 2
dblLeft = oShape.Left
dblWidth = oShape.Width
dblHeight = oShape.Height / oShape.TextFrame.TextRange.Lines.Count
For intLoop = 1 To oTxtRng.Paragraphs.Count
'Add a rectangle
Set oShape = oslide.Shapes.AddShape(1, dblLeft, dblTop, dblWidth, _
dblHeight *
oTxtRng.Paragraphs(intLoop).Lines.Count)
oShape.Fill.ForeColor.RGB = IIf(intLoop Mod 2 = 1, vbWhite, RGB(215,
215, 215))
dblTop = dblTop + (dblHeight * oTxtRng.Paragraphs(intLoop).Lines.Count)
Next

End Sub

 

[Dale Fye]

Thanks guys for all your help on this. The final version of the subroutine
looks like:

Public Sub HighlightTextFrame(oslide As PowerPoint.Slide, _
oShape As PowerPoint.Shape)

'using a static integer so I can call the routine more than once
'on a particular slide
Static intLoopStart As Integer

Dim oNewShape As PowerPoint.Shape
Dim intLoop As Integer
Dim dblTop As Double, dblLeft As Double, dblWidth As Double
Dim dblHeight As Double
Dim ShapeArray() As String
Dim oTxtRng As PowerPoint.TextRange

Set oTxtRng = oShape.TextFrame.TextRange

'This array is for the grouping operation at the end
ReDim ShapeArray(oTxtRng.Paragraphs.Count)

dblTop = oShape.Top + 4
dblLeft = oShape.Left
dblWidth = oShape.Width

'The height of each rectangle is based on the number of
'paragraphs in the shape but need to count the number of
'actual lines in the shape as well
dblHeight = (oShape.Height - 10) / oShape.TextFrame.TextRange.Lines.Count

'Loop through each paragraph in the text range
For intLoop = 1 To oTxtRng.Paragraphs.Count
'Add a rectangle
Set oNewShape = oslide.Shapes.AddShape(1, dblLeft + 5, _
dblTop, dblWidth - 5, _
dblHeight * oTxtRng.Paragraphs(intLoop).Lines.Count)

'name the shape and add it to the ShapeArray
oNewShape.Name = "Highlight" & intLoopStart + intLoop
ShapeArray(intLoop) = oNewShape.Name

'Hide the lines around the rectangle
oNewShape.Line.Visible = False

'Set the fill visible and foreground colors
If intLoop Mod 2 = 1 Then
oNewShape.Fill.Visible = False
Else
oNewShape.Fill.Visible = True
oNewShape.Fill.ForeColor.RGB = RGB(215, 215, 215)
End If

'move the shape backward
While oNewShape.ZOrderPosition > oShape.ZOrderPosition
oNewShape.ZOrder 3 'msoSendBackward
Wend

'Define the top of the next box
dblTop = dblTop + oNewshape.height
Next
oslide.Shapes.Range(ShapeArray).Group
intLoopStart = intLoop

End Sub