Vba word высота таблицы

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

Человек наверное уже сгорел :P а я наконец только додумкал как это лучше…
Сначала я написал функцию, которая вычисляла высоту ячейки таблицы анализируя каждую строчку внутри: т.е. в каждой строчке определ. самый высокий символ + междустрочный интервал — суммируя таким образом все строчки в ячейке получалась высота ячейки.
Потом мне подсказали свойство 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

Так что если кто разобрался с междустрочными интервалами, пусть пишет сюда. :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

Автор 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

Jun 27, 2015 in Tables

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:

Word, Table Initial


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:
Word VBA Resize Column Width 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:
Word VBA Resize Column Result 2
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

Я нашел меньше информации о настройке высоты строки в Интернете, и, наконец, я нашел официальную помощь, но официальная помощь отличная, со ссылкой.
Официальная помощь

Like this post? Please share to your friends:
  • Vba word выпадающий список
  • Vba word range information
  • Vba word вызов функции
  • Vba word print from to
  • Vba word выделить ячейку таблицы