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? Помогите, горю!!!
Всем привет.
Расскажите мне, пожалуйста, кто-нибудь, как определить высоту строки таблицы?
Таблица создается и заполняется автоматически, высота строки задана по умолчанию как wdRowHeightAuto, количество текста, а следовательно и высота строки заранее неизвестны, но при этом нужно отслеживать высоту таблицы и в случае превышения лимита, создавать другую.
Теперь самое интересное: я никак не могу получить реальную высоту строки таблицы, или хотя бы общую высоту таблицы. Если ставлю wdRowHeightAuto, то Height = 99999, если другие, то получаю предустановленное значение, которое не соответствует реальному.
Help! Горю! X)-
Расскажите мне, пожалуйста, кто-нибудь, как определить высоту строки таблицы?
Таблица создается и заполняется автоматически, высота строки задана по умолчанию как wdRowHeightAuto, количество текста, а следовательно и высота строки заранее неизвестны, но при этом нужно отслеживать высоту таблицы и в случае превышения лимита, создавать другую.
Теперь самое интересное: я никак не могу получить реальную высоту строки таблицы, или хотя бы общую высоту таблицы. Если ставлю wdRowHeightAuto, то Height = 99999, если другие, то получаю предустановленное значение, которое не соответствует реальному.
Help! Горю! X)-
Точно знать реальный размер строки в таблице можно только если ее свойство HeightRule:=wdRowHeightExactly, но при это она соответственно автоматически подстраиваться не будет
При других HeightRule:= получаем то что ты описывал: либо 99999, либо старое значение по умолч.
Народ по разговорам давно с этой бедой мучается, мне как-то не надо было, посмотрю конечно тоже, но врядли можно что-то придумать
.... хм, посмотрел еще раз, никак
Вообщем, вижу токо один путь, ставить таблице(строке) HeightRule:=wdRowHeightExactly, а вот AutoFit'ом заняться уже конечно самому, это не так сложно, как может показаться на первый взгляд.... у меня уже есть функции по опред. физ. размеров строк заданого шрифта и размера, так что останется токо каждый раз подгонять под изменяющийся текст размеры таблицы
При других HeightRule:= получаем то что ты описывал: либо 99999, либо старое значение по умолч.
Народ по разговорам давно с этой бедой мучается, мне как-то не надо было, посмотрю конечно тоже, но врядли можно что-то придумать
.... хм, посмотрел еще раз, никак
Вообщем, вижу токо один путь, ставить таблице(строке) HeightRule:=wdRowHeightExactly, а вот AutoFit'ом заняться уже конечно самому, это не так сложно, как может показаться на первый взгляд.... у меня уже есть функции по опред. физ. размеров строк заданого шрифта и размера, так что останется токо каждый раз подгонять под изменяющийся текст размеры таблицы
Цитата:
Originally posted by SergeySV
Точно знать реальный размер строки в таблице можно только если ее свойство HeightRule:=wdRowHeightExactly, но при это она соответственно автоматически подстраиваться не будет
При других HeightRule:= получаем то что ты описывал: либо 99999, либо старое значение по умолч.
Точно знать реальный размер строки в таблице можно только если ее свойство HeightRule:=wdRowHeightExactly, но при это она соответственно автоматически подстраиваться не будет
При других HeightRule:= получаем то что ты описывал: либо 99999, либо старое значение по умолч.
Да мне без разницы каким каком определять, но фиксировать высоту - исключено.
Люди, есть у кого-нибудь готовое решение?
Цитата:
Originally posted by GDragon
Да мне без разницы каким каком определять, но фиксировать высоту - исключено.
Люди, есть у кого-нибудь готовое решение?
Да мне без разницы каким каком определять, но фиксировать высоту - исключено.
Люди, есть у кого-нибудь готовое решение?
Тогда никак.
Хотя ты знаешь, я тут после нового года подумал :D
есть один способ, как говорится в лоб, придется конечно покодить, но считать по идеи должен, будет время накалякаю
есть один способ, как говорится в лоб, придется конечно покодить, но считать по идеи должен, будет время накалякаю
Человек наверное уже сгорел :P а я наконец только додумкал как это лучше...
Сначала я написал функцию, которая вычисляла высоту ячейки таблицы анализируя каждую строчку внутри: т.е. в каждой строчке определ. самый высокий символ + междустрочный интервал - суммируя таким образом все строчки в ячейке получалась высота ячейки.
Потом мне подсказали свойство range.Information(wdVerticalPositionRelativeToPage), таким образом мне достаточто было определить положение первой строчки, потом самой нижней+ее междустрочный интервал. Однако легко только все на словах: проблемы начались уже с определением первой/последней строчки - дело в том, что пустые строчки(которые просто с переводом строки) word не воспринимает как нормальные строчки и не добавляет их полноправно в коллекцию range.Sentences и потому range.Sentences.First (а также range.Sentences.Last) начинали безбожно врать, пришлось писать код по анализу и отлову ситуаций, когда первая/последняя строка в ячейке была пустой. Проблемой осталовалось также определением междустрочного интервала, потому что, то что возвращает свойство .LineSpacing никак не подходит для реальных вычислений, а подобрать формулу у меня так и не получилось. Да там помойму и невозможно это сделать, вот, можете запустить этот макрос и полюбоваться на фактические значения междустрочного интервала для разных шрифтов и множителей.
Так что если кто разобрался с междустрочными интервалами, пусть пишет сюда. :P
Но как говорится, хорошая мысля приходит опосля. Я решил в итоге переделать код и пойти простым путем (не понимаю почему я до этого сразу не додумался): не надо связывать с тектом внутри ячейки, а взять range всей ячейки (соответственно опред. ее верхний край) и вычесть положение верхнего края нижней ячейке. Для последней строки приходится брать параграф следйющий за таблицей (если таблица в самом конце документа, то за ней все равно есть пустой параграф). Пока только еще хорошенько не протестил на возможные баги, если в документе стоит какое-нибудь хитрое обтекание текстом таблицы...
Да, еще такой момент. В одном случае мы можем получить немного завышенное значение высоты - это когда измеряем высоты строки таблицы, которая на этом листе последняя, а следующая уже не умещается и переносится на следующий лист. И тогда соответственно вот на эту величину оставшегося неиспользованного пространства под нашей строкой до конца листа мы и получим ошибку.... Пока еще не знаю, как эту величину можно отследить и вычислить, буду думать... но в любом случае такая ситуация должна возникать редко - чтобы большой кусок листа под последней строкой на листе пропадал.
Сам код:
Сначала я написал функцию, которая вычисляла высоту ячейки таблицы анализируя каждую строчку внутри: т.е. в каждой строчке определ. самый высокий символ + междустрочный интервал - суммируя таким образом все строчки в ячейке получалась высота ячейки.
Потом мне подсказали свойство range.Information(wdVerticalPositionRelativeToPage), таким образом мне достаточто было определить положение первой строчки, потом самой нижней+ее междустрочный интервал. Однако легко только все на словах: проблемы начались уже с определением первой/последней строчки - дело в том, что пустые строчки(которые просто с переводом строки) word не воспринимает как нормальные строчки и не добавляет их полноправно в коллекцию range.Sentences и потому range.Sentences.First (а также range.Sentences.Last) начинали безбожно врать, пришлось писать код по анализу и отлову ситуаций, когда первая/последняя строка в ячейке была пустой. Проблемой осталовалось также определением междустрочного интервала, потому что, то что возвращает свойство .LineSpacing никак не подходит для реальных вычислений, а подобрать формулу у меня так и не получилось. Да там помойму и невозможно это сделать, вот, можете запустить этот макрос и полюбоваться на фактические значения междустрочного интервала для разных шрифтов и множителей.
Код:
Так что если кто разобрался с междустрочными интервалами, пусть пишет сюда. :P
Но как говорится, хорошая мысля приходит опосля. Я решил в итоге переделать код и пойти простым путем (не понимаю почему я до этого сразу не додумался): не надо связывать с тектом внутри ячейки, а взять range всей ячейки (соответственно опред. ее верхний край) и вычесть положение верхнего края нижней ячейке. Для последней строки приходится брать параграф следйющий за таблицей (если таблица в самом конце документа, то за ней все равно есть пустой параграф). Пока только еще хорошенько не протестил на возможные баги, если в документе стоит какое-нибудь хитрое обтекание текстом таблицы...
Да, еще такой момент. В одном случае мы можем получить немного завышенное значение высоты - это когда измеряем высоты строки таблицы, которая на этом листе последняя, а следующая уже не умещается и переносится на следующий лист. И тогда соответственно вот на эту величину оставшегося неиспользованного пространства под нашей строкой до конца листа мы и получим ошибку.... Пока еще не знаю, как эту величину можно отследить и вычислить, буду думать... но в любом случае такая ситуация должна возникать редко - чтобы большой кусок листа под последней строкой на листе пропадал.
Сам код:
Код:
'===================================================================================================
'
' Модуль с функциями по вычислению ВЫСОТЫ ячейки/строки/таблицы
'
'===================================================================================================
'
'
' Основные функции:
' 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
'
' Модуль с функциями по вычислению ВЫСОТЫ ячейки/строки/таблицы
'
'===================================================================================================
'
'
' Основные функции:
' 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