The solution I have come up with involves creating a temporary test textbox for each line in the input textbox, and then inspecting the heights of this new textbox before and after applying the paragraph formatting used in the input textbox:
Option Explicit
' lngLine - the index of the line to compute TextTop and TextHeight for.
' shTextBox - the text box containing the line.
' dblTextTop - returned value for the top of the text.
' dblTextHeight - returned value for the height of the text.
Public Sub TextPosition(ByVal lngLine As Long, _
ByRef shTextBox As Shape, _
ByRef dblTextTop As Double, _
ByRef dblTextHeight As Double)
Dim shTestTextBox As Shape
Dim dblMaxCharHeight As Double
Dim trLine As TextRange
Set trLine = shTextBox.TextFrame.TextRange.Lines(lngLine)
' The height of the derived textbox before manipulation:
Dim dblBaseBoundHeight As Double
dblMaxCharHeight = MaxCharHeight(trLine)
Dim lngSlideIndex As Long
lngSlideIndex = shTextBox.Parent.SlideIndex
With shTextBox.Parent.Parent.Slides(lngSlideIndex)
' Create a one line high text box from the original text box.
' The height of this before and after paragraph formatting is used to
' compute where the text will be in relation to the bounding box of the
' line.
Set shTestTextBox = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
Left:=shTextBox.Left, _
Top:=trLine.BoundTop, _
Width:=shTextBox.Width, _
Height:=trLine.BoundHeight)
End With
shTestTextBox.TextFrame.WordWrap = msoFalse
With shTestTextBox.TextFrame.TextRange
' Any returns at the end of lines (i.e. new paragraphs) must be removed to
' ensure that the test textbox contains only one line.
.Text = Replace(trLine.Text, Chr(13), "")
.Characters(1, .Characters.Count).Font.Size = dblMaxCharHeight
' Record the bound height of the text box before copying over the
' paragraph formatting.
dblBaseBoundHeight = .BoundHeight
.ParagraphFormat.LineRuleAfter = trLine.ParagraphFormat.LineRuleAfter
.ParagraphFormat.SpaceAfter = trLine.ParagraphFormat.SpaceAfter
.ParagraphFormat.LineRuleBefore = trLine.ParagraphFormat.LineRuleBefore
.ParagraphFormat.SpaceBefore = trLine.ParagraphFormat.SpaceBefore
.ParagraphFormat.LineRuleWithin = trLine.ParagraphFormat.LineRuleWithin
.ParagraphFormat.SpaceWithin = trLine.ParagraphFormat.SpaceWithin
End With
dblTextHeight = dblBaseBoundHeight
If lngLine = shTextBox.TextFrame.TextRange.Lines.Count Then
' Space is never added after the last line in a textbox, so the top of the
' text is the bottom of the original bound box less the bound height of
' the (one line high) test textbox.
dblTextTop = (trLine.BoundTop + trLine.BoundHeight) - _
dblBaseBoundHeight
Else
' For the other lines, also allow for the extra space that is inserted
' below a line with paragraph formatting.
dblTextTop = (trLine.BoundTop + trLine.BoundHeight) - _
dblBaseBoundHeight - _
(trLine.BoundHeight - shTestTextBox.TextFrame.TextRange.BoundHeight)
End If
shTestTextBox.Delete
End Sub
Public Function MaxCharHeight(ByRef trLine As TextRange) As Double
Dim i As Long
Dim dblMaxHeight As Double
For i = 1 To trLine.Characters.Count
If trLine.Characters(i, 1).Font.Size > dblMaxHeight Then
dblMaxHeight = trLine.Characters(i, 1).Font.Size
End If
Next i
MaxCharHeight = dblMaxHeight
End Function