Consulting

Results 1 to 3 of 3

Thread: Getting position of top and bottom of text

  1. #1
    VBAX Regular
    Joined
    Mar 2017
    Posts
    23
    Location

    Getting position of top and bottom of text

    I have an add-in which inserts images between lines of text. To make space for the images I increase the line spacing in the text. The problem is I haven't found a way which can consistently and accurately work out where the top and bottom of the text ends up after changing the line spacing.

    For example, if you increase the space using SpaceWithin (or manually), space is actually added above and below the lines of text (more above than below), except for the last line where space is only added above. Any BoundTop and BoundHeight values that I can find refer to the line and not to the characters within it.

    How can I find the top and height measurements for characters within the lines?

    This demonstrates the issue:

    Public Sub PositionTest()
      Dim shTextBox As Shape
      Dim i As Long
      
      With ActivePresentation.Slides(1)
        Set shTextBox = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
                             Left:=300, Top:=100, Width:=300, Height:=100)
      End With
        
      With shTextBox.TextFrame.TextRange
          .Text = "Line number: 1" & vbCrLf & "Line number: 2" & vbCrLf & "Line number: 3"
      End With
      
      With shTextBox.TextFrame.TextRange
      For i = 1 To .Lines.Count
        With .Lines(i, 1)
          Debug.Print .Text & " Top: " & .BoundTop & " Height: " & .BoundHeight
        End With
      Next i
      End With
          
      Debug.Print "New spacing"
      With shTextBox.TextFrame.TextRange
        .Lines.ParagraphFormat.LineRuleWithin = msoTrue
        .Lines.ParagraphFormat.SpaceWithin = 3
      End With
         
      With shTextBox.TextFrame.TextRange
      For i = 1 To .Lines.Count
        With .Lines(i, 1)
          Debug.Print .Text & " Top: " & .BoundTop & " Height: " & .BoundHeight
        End With
      Next i
      End With
    
    End Sub
    And this is the output that that produces:

    Line number: 1
     Top: 103.6 Height: 21.6
    Line number: 2
     Top: 125.2 Height: 21.6
    Line number: 3 Top: 146.8 Height: 21.6
    New spacing
    Line number: 1
     Top: 103.6 Height: 64.8
    Line number: 2
     Top: 168.4 Height: 64.8
    Line number: 3 Top: 233.2 Height: 53.35
    If I try to refer to any individual characters - e.g. .Characters(n).BoundTop - the output is the same as for the line in which that character is in.

  2. #2
    VBAX Regular
    Joined
    Mar 2017
    Posts
    23
    Location
    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

  3. #3
    VBAX Regular
    Joined
    Mar 2017
    Posts
    23
    Location
    I've posted an updated version of this question on StackOverflow - https://stackoverflow.com/questions/...ted-paragraphs

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •