It’s possible to find the row height with Range.Information(). The following snippet doesn’t work for the last row in a table or the last row on a page
Dim Tbl as Table
Dim RowNo as Integer
Dim RowHeight as Double
' set Tbl and RowNo to the table and row number you want to measure
RowHeight=Tbl.Rows(RowNo+1).Range.Information(wdVerticalPositionRelativeToPage) _
- Tbl.Rows(RowNo).Range.Information(wdVerticalPositionRelativeToPage)
This returns the height of the row in points by calculating the difference in position between the selected row and the following one.
I have a routine which works in all cases and returns the height in points of the second and subsequent lines in a cell, i.e. a single-line cell returns 0. (I use this in an application which reduces the font size in certain cells to fit the text on one line.)
Dim Doc As Document
Dim Tbl As Table
Dim Pos As Long
Dim RowNo As Integer
Dim ColNo As Integer
Dim CellHeight As Single
' set Doc, Tbl, RowNo and Colno to the document,table and row number you want to
' measure or provide a cell's range if you prefer
Pos = Tbl.Cell(RowNo, ColNo).Range.End - 1 ' last character in cell
CellHeight = Doc.Range(Pos, Pos).Information(wdVerticalPositionRelativeToTextBoundary)
258
11 января 2005 года
SergeySV
1.5K / / 19.03.2003
Человек наверное уже сгорел а я наконец только додумкал как это лучше…
Сначала я написал функцию, которая вычисляла высоту ячейки таблицы анализируя каждую строчку внутри: т.е. в каждой строчке определ. самый высокий символ + междустрочный интервал — суммируя таким образом все строчки в ячейке получалась высота ячейки.
Потом мне подсказали свойство range.Information(wdVerticalPositionRelativeToPage), таким образом мне достаточто было определить положение первой строчки, потом самой нижней+ее междустрочный интервал. Однако легко только все на словах: проблемы начались уже с определением первой/последней строчки — дело в том, что пустые строчки(которые просто с переводом строки) word не воспринимает как нормальные строчки и не добавляет их полноправно в коллекцию range.Sentences и потому range.Sentences.First (а также range.Sentences.Last) начинали безбожно врать, пришлось писать код по анализу и отлову ситуаций, когда первая/последняя строка в ячейке была пустой. Проблемой осталовалось также определением междустрочного интервала, потому что, то что возвращает свойство .LineSpacing никак не подходит для реальных вычислений, а подобрать формулу у меня так и не получилось. Да там помойму и невозможно это сделать, вот, можете запустить этот макрос и полюбоваться на фактические значения междустрочного интервала для разных шрифтов и множителей.
Код:
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
Так что если кто разобрался с междустрочными интервалами, пусть пишет сюда.
Но как говорится, хорошая мысля приходит опосля. Я решил в итоге переделать код и пойти простым путем (не понимаю почему я до этого сразу не додумался): не надо связывать с тектом внутри ячейки, а взять 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
Автор Sergi92, 23 декабря 2015, 22:07
Sergi92
- Посетитель форума
- Сообщения: 49
- Записан
А помогите пожалуйста! Нам задали написать макрос, который изменяет высоту строк в выделенной таблице, но чтобы можно было сначала ввести размер строки в пунктах и чтобы можно было изменить высоту только четных или только нечетных строк, или только каждую третью сверху таблицы, например 1,3,6,9 и так далее.
Администратор
- Administrator
- Сообщения: 2,252
- Записан
Дробные числа вводите с запятой.
Этот макрос работает с нечётными строками.
Макрос
Sub Main()
Dim tbl As Word.Table, sngHeight As Single, i As Long
‘1. Юзер задаёт высоту строк.
sngHeight = InputBox(«Введите высоту строк в см:»)
‘2. Vba-именование таблицы, в которой находится курсор.
Set tbl = Selection.Tables(1)
‘3. Чтобы можно было задавать высоту:
‘ Диалог «Свойства таблицы» — вкладка «Строка» — область «Размер» — режим: точно.
tbl.Rows.HeightRule = wdRowHeightExactly
‘4. Изменение высоты строк у нечётных строк.
For i = 1 To tbl.Rows.Count Step 2
tbl.Rows(i).Height = CentimetersToPoints(sngHeight)
Next i
‘5. Сообщение.
MsgBox «Макрос завершил работу.», vbInformation
End Sub
[свернуть]
Sergi92
- Посетитель форума
- Сообщения: 49
- Записан
О как быстро! Большущее спасибо!
- Форум по VBA, Excel и Word
-
►
Word -
►
Макросы в Word -
►
Word VBA: Изменить размер строчек в таблице
Создание таблиц в документе Word из кода VBA Excel. Метод Tables.Add, его синтаксис и параметры. Объекты Table, Column, Row, Cell. Границы таблиц и стили.
Работа с Word из кода VBA Excel
Часть 4. Создание таблиц в документе Word
[Часть 1] [Часть 2] [Часть 3] [Часть 4] [Часть 5] [Часть 6]
Таблицы в VBA Word принадлежат коллекции Tables, которая предусмотрена для объектов Document, Selection и Range. Новая таблица создается с помощью метода Tables.Add.
Синтаксис метода Tables.Add
Expression.Add (Range, Rows, Columns, DefaultTableBehavior, AutoFitBehavior) |
Expression – выражение, возвращающее коллекцию Tables.
Параметры метода Tables.Add
- Range – диапазон, в котором будет создана таблица (обязательный параметр).
- Rows – количество строк в создаваемой таблице (обязательный параметр).
- Columns – количество столбцов в создаваемой таблице (обязательный параметр).
- DefaultTableBehavior – включает и отключает автоподбор ширины ячеек в соответствии с их содержимым (необязательный параметр).
- AutoFitBehavior – определяет правила автоподбора размера таблицы в документе Word (необязательный параметр).
Создание таблицы в документе
Создание таблицы из 3 строк и 4 столбцов в документе myDocument без содержимого и присвоение ссылки на нее переменной myTable:
With myDocument Set myTable = .Tables.Add(.Range(Start:=0, End:=0), 3, 4) End With |
Создание таблицы из 5 строк и 4 столбцов в документе Word с содержимым:
With myDocument myInt = .Range.Characters.Count — 1 Set myTable = .Tables.Add(.Range(Start:=myInt, End:=myInt), 5, 4) End With |
Для указания точки вставки таблицы присваиваем числовой переменной количество символов в документе минус один. Вычитаем единицу, чтобы исключить из подсчета последний знак завершения абзаца (¶), так как точка вставки не может располагаться за ним.
Последний знак завершения абзаца всегда присутствует в документе Word, в том числе и в новом без содержимого, поэтому такой код подойдет и для пустого документа.
При создании, каждой новой таблице в документе присваивается индекс, по которому к ней можно обращаться:
myDocument.Tables(индекс) |
Нумерация индексов начинается с единицы.
Отображение границ таблицы
Новая таблица в документе Word из кода VBA Excel создается без границ. Отобразить их можно несколькими способами:
Вариант 1
Присвоение таблице стиля, отображающего все границы:
myTable.Style = «Сетка таблицы» |
Вариант 2
Отображение внешних и внутренних границ в таблице:
With myTable .Borders.OutsideLineStyle = wdLineStyleSingle .Borders.InsideLineStyle = wdLineStyleSingle End With |
Вариант 3
Отображение всех границ в таблице по отдельности:
With myTable .Borders(wdBorderHorizontal) = True .Borders(wdBorderVertical) = True .Borders(wdBorderTop) = True .Borders(wdBorderLeft) = True .Borders(wdBorderRight) = True .Borders(wdBorderBottom) = True End With |
Присвоение таблицам стилей
Вариант 1
myTable.Style = «Таблица простая 5» |
Чтобы узнать название нужного стиля, в списке стилей конструктора таблиц наведите на него указатель мыши. Название отобразится в подсказке. Кроме того, можно записать макрос с присвоением таблице стиля и взять название из него.
Вариант 2
myTable.AutoFormat wdTableFormatClassic1 |
Выбирайте нужную константу с помощью листа подсказок свойств и методов – Auto List Members.
Обращение к ячейкам таблицы
Обращение к ячейкам второй таблицы myTable2 в документе myDocument по индексам строк и столбцов:
myTable2.Cell(nRow, nColumn) myDocument.Tables(2).Cell(nRow, nColumn) |
- nRow – номер строки;
- nColumn – номер столбца.
Обращение к ячейкам таблицы myTable в документе Word с помощью свойства Cell объектов Row и Column и запись в них текста:
myTable.Rows(2).Cells(2).Range = _ «Содержимое ячейки во 2 строке 2 столбца» myTable.Columns(3).Cells(1).Range = _ «Содержимое ячейки в 1 строке 3 столбца» |
В таблице myTable должно быть как минимум 2 строки и 3 столбца.
Примеры создания таблиц Word
Пример 1
Создание таблицы в новом документе Word со сплошными наружными границами и пунктирными внутри:
Sub Primer1() Dim myWord As New Word.Application, _ myDocument As Word.Document, myTable As Word.Table Set myDocument = myWord.Documents.Add myWord.Visible = True With myDocument Set myTable = .Tables.Add(.Range(0, 0), 5, 4) End With With myTable .Borders.OutsideLineStyle = wdLineStyleSingle .Borders.InsideLineStyle = wdLineStyleDot End With End Sub |
В выражении myDocument.Range(Start:=0, End:=0)
ключевые слова Start и End можно не указывать – myDocument.Range(0, 0)
.
Пример 2
Создание таблицы под ранее вставленным заголовком, заполнение ячеек таблицы и применение автосуммы:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 |
Sub Primer2() On Error GoTo Instr Dim myWord As New Word.Application, _ myDocument As Word.Document, _ myTable As Word.Table, myInt As Integer Set myDocument = myWord.Documents.Add myWord.Visible = True With myDocument ‘Вставляем заголовок таблицы .Range.InsertAfter «Продажи фруктов в 2019 году» & vbCr myInt = .Range.Characters.Count — 1 ‘Присваиваем заголовку стиль .Range(0, myInt).Style = «Заголовок 1» ‘Создаем таблицу Set myTable = .Tables.Add(.Range(myInt, myInt), 4, 4) End With With myTable ‘Отображаем сетку таблицы .Borders.OutsideLineStyle = wdLineStyleSingle .Borders.InsideLineStyle = wdLineStyleSingle ‘Форматируем первую и четвертую строки .Rows(1).Range.Bold = True .Rows(4).Range.Bold = True ‘Заполняем первый столбец .Columns(1).Cells(1).Range = «Наименование» .Columns(1).Cells(2).Range = «1 квартал» .Columns(1).Cells(3).Range = «2 квартал» .Columns(1).Cells(4).Range = «Итого» ‘Заполняем второй столбец .Columns(2).Cells(1).Range = «Бананы» .Columns(2).Cells(2).Range = «550» .Columns(2).Cells(3).Range = «490» .Columns(2).Cells(4).AutoSum ‘Заполняем третий столбец .Columns(3).Cells(1).Range = «Лимоны» .Columns(3).Cells(2).Range = «280» .Columns(3).Cells(3).Range = «310» .Columns(3).Cells(4).AutoSum ‘Заполняем четвертый столбец .Columns(4).Cells(1).Range = «Яблоки» .Columns(4).Cells(2).Range = «630» .Columns(4).Cells(3).Range = «620» .Columns(4).Cells(4).AutoSum End With ‘Освобождаем переменные Set myDocument = Nothing Set myWord = Nothing ‘Завершаем процедуру Exit Sub ‘Обработка ошибок Instr: If Err.Description <> «» Then MsgBox «Произошла ошибка: « & Err.Description End If If Not myWord Is Nothing Then myWord.Quit Set myDocument = Nothing Set myWord = Nothing End If End Sub |
Метод AutoSum суммирует значения в ячейках одного столбца над ячейкой с суммой. При использовании его для сложения значений ячеек в одной строке, результат может быть непредсказуемым.
Чтобы просуммировать значения в строке слева от ячейки с суммой, используйте метод Formula объекта Cell:
myTable.Cell(2, 4).Formula («=SUM(LEFT)») |
Другие значения метода Formula, применяемые для суммирования значений ячеек:
- «=SUM(ABOVE)» – сумма значений над ячейкой (аналог метода AutoSum);
- «=SUM(BELOW)» – сумма значений под ячейкой;
- «=SUM(RIGHT)» – сумма значений справа от ячейки.
Word VBA Resize Table Columns and Rows
In this article I will explain how you can use VBA for word to resize table columns and rows.
Every word document has a Tables collection The first step in working with a table in VBA for word is to determine the table index. Tables in a word document start from the index “1” and go up. So for example the first table would be referenced by using the statement below:
Tables.Item(1)
The second table would be reference by using:
Tables.Item(2)
and so on . . .
All examples in this article will use the table below as their initial table:
–
Modify Row Height:
The code below will change the height of the first row of the first table to 50 points:
Tables.Item(1).Rows.Item(1).Height = 50
Result:
–
Modify Column Width:
The code below will change the width of the first column to 20 points:
Tables.Item(1).Columns(2).Width = 20
Result:
You can download the file and code related to this article from the link below:
- Resize Columns Rows Tables.docm
See also:
- VBA, Word Table Insert/Remove Rows/Columns
- Word VBA, Modify Table Data
- Word VBA, Delete Empty Rows From Tables
Формулировка задачи:
Здравствуйте!
Помогите определить высоту всей таблицы в документе Word.
Я пытался делать вот так:
В результате x =
5E+07
.
Я понимаю, что в «Свойства таблицы» режим размера строки установлен «Минимум» и это от этого.
Как определить высоту таблицы или диапазона, который занимает таблица, не изменяя режим «Минимум»?
Код к задаче: «Как определить высоту всей таблицы в документе Word?»
textual
Dim x As Word.Range Set x = ActiveDocument.Tables(1).Range Debug.Print ActiveDocument.Range(x.End).Information(wdVerticalPositionRelativeToPage) - _ ActiveDocument.Range(x.Start).Information(wdVerticalPositionRelativeToPage)
Полезно ли:
6 голосов , оценка 3.833 из 5
Из-за работы по проверке документов существует большой документ с сотнями страниц и от трех до четырехсот таблиц. Требуется отрегулировать высоту их строк, чтобы сохранить внешний вид и максимально уменьшить количество страниц. Если вы измените его вручную, мышь сломается, поэтому я подумал о методе макроса.
Метод использования макросов следующий:
(1) Включить макрос
Файл -> Параметры -> Центр управления безопасностью -> Настройки центра управления безопасностью -> Включить все макросы
(2) Найдите «макрос» в строке поиска, выберите «просмотреть макрос» и выберите «Редактировать».
(3) Введите часть макроса для редактирования кода
Далее идет редактирование кода. Мое требование: начиная с пятой таблицы, каждая таблица открывается с фиксированным межстрочным интервалом от четвертой строки.
Sub макрос1()
Dim h
Dim i
Dim n
On Error Resume Next «Игнорировать ошибку
WidthP = 80 'Установить фиксированную высоту строки
For n = 5 To ActiveDocument.Tables.Count
For i = 4 To ActiveDocument.Tables(n).Rows.Count
ActiveDocument.Tables(n).Rows(i).Height = WidthP 'Установить номер строки
Next
Next
End Sub
Я нашел меньше информации о настройке высоты строки в Интернете, и, наконец, я нашел официальную помощь, но официальная помощь отличная, со ссылкой.
Официальная помощь