Word: Измерить междустрочный интервал

[SergeySV2]

Проблема в получении точного значения междустрочного интервала (хотя бы в points) .

Знаю что в worde есть такое замечательное свойство: .LineSpacing, но хранит оно 12 для 1 интерв.; 18 для 1,5 интерв.; 24 для 2 интерв. То что гласит справка - о +6 points на размер самой большой буквы в строке - тоже не применимо.

Оговорюсь сразу, возможно то что мне нужно и не называется междустрочным интервалом в понимании программистов microsoft, допустим это, хорошо, тогда мне нужен РЕАЛЬНЫЙ междустрочный интервал - МНЕ НУЖНО ЗНАТЬ СКОЛЬКО НЕОБХОДИМО ПРИБАВИТЬ points к размеру шрифта строки, чтобы получить положение верхнего края следующей строки.

Чтобы сразу было понятно о чем говорю:
Посмотреть на эти значения можно очень просто запустив этот макрос:

Код: Выделить всё

Sub Macros1()
Dim i As Long, k As Long
Dim raz As Single
Dim rTemp As Range

ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
        1, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
ActiveDocument.Tables(1).Cell(1, 1).Range.Text = "df" & vbCrLf & "df"

For k = 1 To 12
  For i = 8 To 22

    ActiveDocument.Tables(1).Cell(1, 1).Range.Sentences(1).Font.Size = i
    ActiveDocument.Tables(1).Cell(1, 1).Range.Sentences(1).ParagraphFormat.LineSpacing = 6 + 6 * k
         
    Set rTemp = ActiveDocument.Tables(1).Cell(1, 1).Range.Sentences(2)
    Set rTemp = ActiveDocument.Range(Start:=rTemp.Start, End:=rTemp.Start + 3)
         
    raz = rTemp.Information(wdVerticalPositionRelativeToPage) _
        - ActiveDocument.Tables(1).Cell(1, 1).Range.Sentences(1).Information(wdVerticalPositionRelativeToPage)
    raz = raz - i
   
    Debug.Print "Коэф. междустр интерв-" & (k - 1) / 2 + 1 & " Размер шрифта-" & i & " Реальн междустр интервал-" & raz
  Next i
Next k
End Sub


Пытался я вникнуть в тайный смысл этих значений, каким же образом word их вычисляет???

Так я провел измерения и составил следующие уравнения зависимости для каждого из множителя межстр. интервала Nx (зависимость реального межстр. интервала от размера шрифта):
для 1x — y=0,2354*SizeFont-1,1776
для 1,5x — y=0,8546*SizeFont-1,8663
для 2x — y=1,4729*SizeFont-2,4965
для 2,5x — y=2,0819*SizeFont-2,7935
для 4x — y=3,9928*SizeFont-7,1573
для 6x — y=0,1551*SizeFont-1,2053
.... в начале вроде намечается тенденция, однако после 4x, она вся сходит на нет...

Вообщем я уже голову сломал пытаясь вычислить реальный межстрочный интервал в points'ах. Можно конечно же брать каждый раз реальные строки и сравнивать их положение, но сами понимаете, что это не очень удобно, особенного для фоного измерения.... Может кто-нибудь смог разобраться с этими междустрочными интервалами???

[SergeySV2]

Поскольку по задаче мне нужно было вычислить междустрочный интервал последней строки ячейки таблицы, то пока я решил вывернуться из ситуации с помощью следующей написанной функции:

Код: Выделить всё

Public Function LineSpacLastRowInCell(rRowLast As Range, snRoundHeightCell As Single) As Single
    ' Вычисляет междустрочный интервал последней строки в ячейке таблицы,
    ' путем: дублирования последней строки и измерения интервала между ними через .Information(wdVerticalPositionRelativeToPage)
    ' чтобы ячейка не меняла размер, мы временно фиксируем его и возвращаем потом все свойства назад.
    '
    ' Аргументы:
    ' [rRowLast] - последняя строка ячейки таблицы
    ' [snRoundHeightCell] - приближен. размер ячейки, нужен для того чтобы ячейка во время вычисления
    '                       междустр. интервала, ячейка не меняла сильно свой размер, и не дергала за собой весь текст документа
    ' Использует другие вспомог. функции: MaxFontSizeInRange()
   
    Dim scSpecSymbEndCell As String
    Dim rTemp As Range, rTemp2 As Range
    Dim bolAddSymb As Boolean
    Dim OldRowHeightRule As WdRowHeightRule
    Dim OldRowHeight As Single
    Dim snMaxFontSize As Single
    Dim lLenText As Long
    Dim sText As String
   
    On Error GoTo Er_
   
    scSpecSymbEndCell = Chr(13) & Chr(7)
    Set rTemp = rRowLast
   
    ' проверям на наличие спец. символов оконч. ячейки:
    ' если .Range.Sentences.Last, то - chr(13) & chr(7)
    ' если .Range.Sentences(НомерПоследСтроки), то - chr(13)
    If Len(rTemp.Text) > 1 Then
      ' отрезаем ненужные нам спец. символы
      If Right(rTemp.Text, 2) = scSpecSymbEndCell Or _
         Right(rTemp.Text, 1) = Chr(13) Then
           Set rTemp = rTemp.Document.Range(Start:=rTemp.Start, End:=rTemp.End - 1)
      End If
    End If
   
    ' проверям не пустая ли строка (если пустая, то добавим один символ для измер.
    ' и уберем потом его)
    If Len(rTemp.Text) = 0 Then
      rTemp.Text = rTemp.Text & "."
      bolAddSymb = True
    End If
   
    ' меняем тип ячеки на wdRowHeightExactly - (чтобы размер ячейки не дергался при добавлении строки)
    OldRowHeight = rTemp.Cells(1).Height
    OldRowHeightRule = rTemp.Cells(1).HeightRule
    snMaxFontSize = MaxFontSizeInRange(rTemp)
    rTemp.Cells(1).Height = snRoundHeightCell
    rTemp.Cells(1).HeightRule = wdRowHeightExactly
   
    ' дублируем последн. строку
    sText = rTemp.Text
    lLenText = Len(rTemp.Text)
    rTemp.Text = rTemp.Text & vbCrLf & rTemp.Text
    ' получаем range на добавл. строку
    Set rTemp2 = rTemp.Document.Range(Start:=rTemp.Start + lLenText + 1, End:=rTemp.End)

    ' измеряем междустрочный интервал между строками
    LineSpacLastRowInCell = rTemp2.Information(wdVerticalPositionRelativeToPage) _
                          - rTemp.Information(wdVerticalPositionRelativeToPage) _
                          - snMaxFontSize

    ' удаляем добавленную строку
    rTemp.Text = sText
    ' возвращаем добавлен. символ
    If bolAddSymb Then
       rTemp.Text = Left(rTemp.Text, Len(rTemp.Text) - 1)
    End If
    ' возвращаем обратно свойства Cell
    rTemp.Cells(1).HeightRule = OldRowHeightRule
    If OldRowHeight <> 9999999 Then _
       rTemp.Cells(1).Height = OldRowHeight
   
Ex_:
  Exit Function

Er_:
  LineSpacLastRowInCell = 0
  Resume Ex_

End Function

Public Function MaxFontSizeInRange(rRange As Range) As Single
  ' возвращает мак. размер символов в Range
  Dim i As Long
   
  ' цикл по кажому символу в range
  For i = 1 To rRange.Characters.Count
      ' опред. высоту символа и запомин. макс.
      If MaxFontSizeInRange < rRange.Characters(i).Font.Size Then
            MaxFontSizeInRange = rRange.Characters(i).Font.Size
      End If
  Next i
     
End Function


Вообще я занимаюсь задачей - вычисления высоты Row/Table, когда свойство .HeightRule не равно wdRowHeightExactly. Кто сталкивался с этим, хорошо знает какие в Word с определ. высоты начинаются проблемы тогда

[SergeySV2]

Да, функция LineSpacLastRowInCell пока еще не дописана до конца, она пока не учитывает ситуацию, когда ячейка находится на самом краю листа и добавлен. строка может перенестись на след. страницу

P.S. дополняю код этой функцией:

Код: Выделить всё

Public Function AbsDistBetwenRanges(r1 As Range, r2 As Range) As Single
  ' измеряет абсолютное расстояние (в points) между двумя range'ми (их верхними углами),
  ' учитывая тот факт, что range'ы могут находится на разных листах
  ' и у каждого листа может быть свой размер и свои отступы
  '
  ' К сожалению в вычислениях пока не учитывается тот факт - что строки в ячейке таблицы
  ' распологаются на листе так, чтобы их уместилось целое кол-во и потому они не занимают
  ' весь лист по высоте (чтобы это учесть, надо еще на каждом промеж. листе вычислять высоту
  ' попавших строчек с их междустрочными интервалами)
  '
  '[r1] - первый range
  '[r2] - второй range, между которыми будет измеряться расстояние.
 
  Dim snR1Top As Single, snR2Top As Single
  Dim snR1Page As Single, snR2Page As Single
  Dim snDistPages As Single
  Dim rTemp As Range
  Dim i As Long
     
  On Error GoTo Er_
 
  snR1Top = r1.Information(wdVerticalPositionRelativeToPage)
  snR2Top = r2.Information(wdVerticalPositionRelativeToPage)
  snR1Page = r1.Information(wdActiveEndPageNumber)
  snR2Page = r2.Information(wdActiveEndPageNumber)
 
  Set rTemp = r1
 
  ' определяем кто выше
  If snR1Page < snR2Page Then
     ' считаем страницы между ними
     For i = snR1Page + 1 To snR2Page - 1
       Set rTemp = rTemp.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i)
       snDistPages = snDistPages + rTemp.PageSetup.PageHeight _
                                 - rTemp.PageSetup.BottomMargin _
                                 - rTemp.PageSetup.TopMargin
     Next i
     ' вычисляем итоговое расстояние
     AbsDistBetwenRanges = r1.PageSetup.PageHeight - r1.PageSetup.BottomMargin - snR1Top _
                           + snDistPages _
                           + snR2Top - r2.PageSetup.TopMargin
 
 
  ElseIf snR1Page > snR2Page Then
     ' считаем страницы между ними
     For i = snR2Page + 1 To snR1Page - 1
       Set rTemp = rTemp.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i)
       snDistPages = snDistPages + rTemp.PageSetup.PageHeight _
                                 - rTemp.PageSetup.BottomMargin _
                                 - rTemp.PageSetup.TopMargin
     Next i
     ' вычисляем итоговое расстояние
     AbsDistBetwenRanges = r2.PageSetup.PageHeight - r2.PageSetup.BottomMargin - snR2Top _
                           + snDistPages _
                           + snR1Top - r1.PageSetup.TopMargin
 
 
  Else ' на одной странице находятся
    AbsDistBetwenRanges = Abs(snR1Top - snR2Top)
  End If

Ex_:
  Exit Function

Er_:
  AbsDistBetwenRanges = 0
  Resume Ex_
 
End Function


Возможно у кого-нибудь другие идеи по вычислению междустрочного интервала?

GSerg: а ты решил эту проблему?
http://bbs.vbstreets.ru/viewtopic.php?t ... light=word

[SergeySV2]

В итоге решил для измерения высоты строки/таблицы в Worde написать такую функцию. До конца ее не оттестил, если заметите баги, пишите сюда, будем дошлифовывать:

Код: Выделить всё

'=================================================
==================================================
'
'                       Модуль с функциями по вычислению ВЫСОТЫ ячейки/строки/таблицы
'
'=================================================
==================================================
'
'
' Основные функции:
' 1. HeightRow             - вычисляет высоту выбранной строки таблицы
' 2. HeightTable           - вычисляет высоту таблицы
'
' Вспомогательные функции:
' 1. AbsDistBetwenRanges  - измеряет абсол. расстояние между двумя range'ами
'
'=================================================
==================================================
Option Explicit


Public Function HeightRow(rRow As Row) As Single
  ' Функция вычисляет высоту выбранной строки таблицы
  '
  '[rRow] - строка таблицы, можно передавать например так - ActiveDocument.Tables(1).Rows(1)

  Dim tTable As Table
  Dim cCell As Cell
  Dim r1 As Range, r2 As Range
  Dim lMaxCol As Long, lMaxRow As Long
 
  On Error GoTo Er_
 
  Set tTable = rRow.Parent
       
  ' проверяем, может нам и не придется вычислять высоту строки самим
  For Each cCell In rRow.Cells
    If cCell.HeightRule = wdRowHeightExactly Then
      HeightRow = cCell.Height
      GoTo Ex_
    End If
  Next
   
  ' позиция Top
  Set r1 = rRow.Range
 
  If rRow.Index < tTable.Rows.Count Then
    ' получ. след. строку таблицы
    Set r2 = tTable.Rows(rRow.Index + 1).Range
  Else
    ' это послед. строка таблицы
    lMaxRow = tTable.Range.Information(wdMaximumNumberOfRows)
    lMaxCol = tTable.Range.Information(wdMaximumNumberOfColumns)
    ' переходим на параграф следующ. за таблицей, он станет нашим нижним range
    Set r2 = tTable.Cell(lMaxRow, lMaxCol).Range
    With r2
      .Collapse Direction:=wdCollapseStart
      .Move Unit:=wdParagraph, Count:=2
      .Select
    End With
  End If
   
  ' вычисляем высоту
  HeightRow = AbsDistBetwenRanges(r1, r2)
 
Ex_:
  Exit Function
Er_:
  HeightRow = 0
  Resume Ex_
 
End Function


Public Function HeightTable(tTable As Table) As Single
  ' Функция вычисляет высоту таблицы
  '
  '[tTable] - ссылка на таблицу, можно передавать например так - ActiveDocument.Tables(1)
  Dim r1 As Range, r2 As Range
  Dim lMaxCol As Long, lMaxRow As Long
 
  On Error GoTo Er_
 
  ' позиция Top
  Set r1 = tTable.Cell(1, 1).Range
 
  ' позиция Bottom
  lMaxRow = tTable.Range.Information(wdMaximumNumberOfRows)
  lMaxCol = tTable.Range.Information(wdMaximumNumberOfColumns)
  Set r2 = tTable.Cell(lMaxRow, lMaxCol).Range
  With r2
      .Collapse Direction:=wdCollapseStart
      .Move Unit:=wdParagraph, Count:=2
      .Select
  End With
   
  ' вычисляем высоту
  HeightTable = AbsDistBetwenRanges(r1, r2)
 
Ex_:
  Exit Function
Er_:
  HeightTable = 0
  Resume Ex_
 
End Function


Public Function AbsDistBetwenRanges(r1 As Range, r2 As Range) As Single
  ' измеряет абсолютное расстояние (в points) между двумя range'ми (их верхними углами),
  ' учитывая тот факт, что range'ы могут находится на разных листах
  ' и у каждого листа может быть свой размер и свои отступы
  '
  '[r1] - первый range
  '[r2] - второй range, между которыми будет измеряться расстояние.
 
  Dim snR1Top As Single, snR2Top As Single
  Dim snR1Page As Single, snR2Page As Single
  Dim snDistPages As Single
  Dim rTemp As Range
  Dim i As Long
     
  On Error GoTo Er_
 
  snR1Top = r1.Information(wdVerticalPositionRelativeToPage)
  snR2Top = r2.Information(wdVerticalPositionRelativeToPage)
  snR1Page = r1.Information(wdActiveEndPageNumber)
  snR2Page = r2.Information(wdActiveEndPageNumber)
 
  Set rTemp = r1
 
  ' определяем кто выше
  If snR1Page < snR2Page Then
     ' считаем страницы между ними
     For i = snR1Page + 1 To snR2Page - 1
       Set rTemp = rTemp.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i)
       snDistPages = snDistPages + rTemp.PageSetup.PageHeight _
                                 - rTemp.PageSetup.BottomMargin _
                                 - rTemp.PageSetup.TopMargin
     Next i
     ' вычисляем итоговое расстояние
     AbsDistBetwenRanges = r1.PageSetup.PageHeight - r1.PageSetup.BottomMargin - snR1Top _
                           + snDistPages _
                           + snR2Top - r2.PageSetup.TopMargin
 
 
  ElseIf snR1Page > snR2Page Then
     ' считаем страницы между ними
     For i = snR2Page + 1 To snR1Page - 1
       Set rTemp = rTemp.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i)
       snDistPages = snDistPages + rTemp.PageSetup.PageHeight _
                                 - rTemp.PageSetup.BottomMargin _
                                 - rTemp.PageSetup.TopMargin
     Next i
     ' вычисляем итоговое расстояние
     AbsDistBetwenRanges = r2.PageSetup.PageHeight - r2.PageSetup.BottomMargin - snR2Top _
                           + snDistPages _
                           + snR1Top - r1.PageSetup.TopMargin
 
 
  Else ' на одной странице находятся
    AbsDistBetwenRanges = Abs(snR1Top - snR2Top)
  End If
Ex_:
  Exit Function
Er_:
  AbsDistBetwenRanges = 0
  Resume Ex_
 
End Function


P.S. Да, еще такой момент. В одном случае мы можем получить немного завышенное значение высоты - это когда измеряем высоты строки таблицы, которая на этом листе последняя, а следующая уже не умещается и переносится на следующий лист. И тогда соответственно вот на эту величину оставшегося неиспользованного пространства под нашей строкой до конца листа(в смысле до начала нижнего отступа) мы и получим ошибку.... Пока еще не знаю, как эту величину можно отследить и вычислить, буду думать... но в любом случае такая ситуация должна возникать редко - чтобы большой кусок листа под последней строкой на листе пропадал.

[codemaster]

ради интереса посмотри

http://www.rsdn.ru/Forum/Message.aspx?mid=974229&only=1

особенно обрати внимание на Information

[SergeySV2]

ради интереса посмотри

http://www.rsdn.ru/Forum/Message.aspx?mid=974229&only=1

особенно обрати внимание на Information

Это мой топик , именно там мне и подсказали про удобное свойство .Information

В последних примерах я его и использовал. У него только одна проблема, что возвращает оно только положение ВЕРХНЕГО УГЛА объекта Range..... поэтому в последнем примере, для получения высоты строки я делаю так, получаю положение верхнего края этой строки, а потом приходится брать верний угол следующей строки, ну и вычитанием уже и получаем высоту.
Если строка таблица уже сама последняя, то приходится перемещаться ниже, на следующий за ней параграф и уже его координаты брать.

Остался только один не решенный вопрос, что делать если начало и конец находится на разных листах. Кол-во и высоты этих листов (с их отступами) я конечно же учитываю, НО вот то, что не всю высоту листа может использовать текст/таблица - это да, пока в моем кода не учитывается, не знаю пока как определить, что например строка таблицы высотой 50 points, а место на листе отстается только на 40 points. Word берет строку, переносит на следующий лист, а на этом листе остается неиспользованные 40 points. И вот если мы теперь будем определить высоту всей таблицы и вычитать из положение конца таблицы, положение начала, то получим завышенную высоту на эти самые 40 points
..... долго объясняется, хоть суть вообщем должна быть всем понятна