Есть некоторый текст. Его необходимо преобразовать в таблицу. Количество столбцов всегда одинаковое. Количество строк меняется. текст нужно преобразовать не весь а от 6 обзаца. Номер обзаца не меняется.
Вот такой макрос преобразует в таблицу весь текст документа. Помогите, пожалуйста, исправить.
Спойлер
Sub ПреобразованиеТекставТаблицу()
'
Selection.WholeStory
Selection.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=8, _
NumRows:=14, AutoFitBehavior:=wdAutoFitFixed
With Selection.Tables(1)
.Style = "Сетка таблицы"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
End With
End Sub
Написал вам два письма на почту с заголовком "Письмо с Форума по VBA, Excel и Word". Написал именно на почту, а не на форум.
Макрос
Sub ПреобразованиеТекставТаблицу()
Dim Rng As Range
Set Rng = ActiveDocument.Paragraphs(6).Range
Rng.End = ActiveDocument.Range.End
Rng.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=8, _
NumRows:=14, AutoFitBehavior:=wdAutoFitFixed
With Rng.Tables(1)
.Style = "Сетка таблицы"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
End With
End Sub
Написал вам два письма на почту с заголовком "Письмо с Форума по VBA, Excel и Word". Написал именно на почту, а не на форум.
В макросе я сделал ширины для первых двух столбцов, вам надо по аналогии сделать для остальных. Для последнего не делайте - ему достанется остаток.
Макрос
Sub ПреобразованиеТекставТаблицу()
Dim Rng As Range
Set Rng = ActiveDocument.Paragraphs(6).Range
Rng.End = ActiveDocument.Range.End
Rng.ConvertToTable Separator:=wdSeparateByTabs, NumColumns:=8, _
NumRows:=14, AutoFitBehavior:=wdAutoFitFixed
With Rng.Tables(1)
' Назначение таблице стиля и установка параметров стиля.
.Style = "Сетка таблицы"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
' Делаем таблицу по ширине окна, чтобы при изменении ширин столбцов, ширина таблицы
' оставалась исходной.
.AutoFitBehavior wdAutoFitWindow
' Меняем проценты на пункты (чтобы работать с сантиметрами).
.Columns(1).PreferredWidthType = wdPreferredWidthPoints
' Меняем ширины всех столбцов, кроме последнего.
' Для последнего останется остаток.
.Columns(1).PreferredWidth = CentimetersToPoints(2)
.Columns(2).PreferredWidth = CentimetersToPoints(2)
End With
End Sub