Автор Тема: Преобразование текста в таблицу  (Прочитано 53 раз)

Оффлайн Посетитель 22.09.2022

  • Посетитель форума
  • Сообщений: 1
Преобразование текста в таблицу
« : 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

Оффлайн Администратор

  • Administrator
  • Сообщений: 2066
Re: Преобразование текста в таблицу
« Ответ #1 : 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

Оффлайн Посетитель 24.09.2022

  • Посетитель форума
  • Сообщений: 3
Re: Преобразование текста в таблицу
« Ответ #2 : 23 Сентябрь 2022, 20:08 »
А как можно в этой таблице прописать разную ширину каждого столбца?

Оффлайн Администратор

  • Administrator
  • Сообщений: 2066
Re: Преобразование текста в таблицу
« Ответ #3 : 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