Форум по VBA, Excel и Word

Word => Макросы в Word => Тема начата: Посетитель от 14 сентября 2022, 18:57

Название: Преобразование текста в таблицу
Отправлено: Посетитель от 14 сентября 2022, 18:57
Есть некоторый текст. Его необходимо преобразовать в таблицу. Количество столбцов всегда одинаковое. Количество строк меняется. текст нужно преобразовать не весь а от 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
[свернуть]
Название: Re: Преобразование текста в таблицу
Отправлено: Администратор от 15 сентября 2022, 00:42
Написал вам два письма на почту с заголовком "Письмо с Форума по 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
[свернуть]
Название: Re: Преобразование текста в таблицу
Отправлено: Посетитель от 23 сентября 2022, 20:08
А как можно в этой таблице прописать разную ширину каждого столбца?
Название: Re: Преобразование текста в таблицу
Отправлено: Администратор от 23 сентября 2022, 20:39
Написал вам два письма на почту с заголовком "Письмо с Форума по 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
[свернуть]