Как создать макрос Outlook, который обновляет атрибуты таблицы, чтобы сжать таблицу до содержащегося в ней текста без переносов?

Как создать макрос Outlook, который обновляет атрибуты таблицы, чтобы сжать таблицу до содержащегося в ней текста без переносов?

Обновлено:Обновлен макрос с исправлением.

Версия: Outlook 2013

Я хочу иметь возможность...

  1. Измените размер шрифта текста в таблице.(Сделанный)
  2. Удалите (снимите флажки) атрибуты «Предпочтительная ширина» из активных атрибутов таблицы, столбца и ячейки.
  3. Удалите (снимите флажок) атрибут «Указанная высота» из строк таблицы.

Если я использую aTbl.Columns.PreferredWidth = Uncheckedдля сжатия столбцов, он делает перенос слов и не снимает флажок. Я хочу, чтобы он НЕ переносил слова.

Если я использую autoFit, то он выглядит так же, как aTbl.Columns.PreferredWidth = Unchecked.

Если я задам столбцы по отдельности, это будет выглядеть так же, как aTbl.Columns.PreferredWidth = Unchecked.

Пришлось импортировать библиотеку объектов MS Word:

Импорт библиотеки объектов MS Word

Что у меня есть на данный момент:

Public Sub FormatSelectedText()
    Dim objItem As Object
    Dim objInsp As Outlook.Inspector

    ' Add reference to Word library in VBA Editor, Tools, References
    Dim objWord As Word.Application
    Dim objDoc As Word.Document
    Dim objSel As Word.Selection
    'On Error Resume Next

    'Reference the current Outlook item
    Set objItem = Application.ActiveInspector.CurrentItem
    If Not objItem Is Nothing Then
        If objItem.Class = olMail Then
            Set objInsp = objItem.GetInspector
            If objInsp.EditorType = olEditorWord Then
                Set objDoc = objInsp.WordEditor
                Set objWord = objDoc.Application
                Set objSel = objWord.Selection

                objSel.Font.Size = 8
                Dim aTbl As Word.Table
                For i = 1 To objSel.Tables.Count()
                    Set aTbl = objSel.Tables.Item(i)
                    aTbl.Borders.InsideLineStyle = wdLineStyleSingle
                    aTbl.Borders.OutsideLineStyle = wdLineStyleSingle
                    aTbl.Rows.Height = Unchecked
                    aTbl.Rows.AllowBreakAcrossPages = False
                    aTbl.Columns.PreferredWidth = Unchecked
                    aTbl.Columns.PreferredWidthType = wdPreferredWidthAuto
                    aTbl.PreferredWidth = Unchecked
                Next
            End If
        End If
    End If

    Set objItem = Nothing
    Set objWord = Nothing
    Set objSel = Nothing
    Set objInsp = Nothing
End Sub

Как это выглядит до сценария:

До

Ожидаемый результат:

ожидаемый результат

После выполнения без aTbl.Columns.PreferredWidth = Unchecked(закрывает, но не сжимает столбцы):

С предпочитаемой шириной

После бега с aTbl.Columns.PreferredWidth = Unchecked(просто... нет):

Без предпочитаемой ширины

Пример настроек, которые необходимо изменить для корректного изменения таблицы:

Свойства таблицы - Таблица Свойства таблицы - строка Свойства таблицы - Столбец Свойства таблицы - Ячейка

решение1

Для меня это сработало:

                aTbl.Columns.PreferredWidth = Unchecked
                aTbl.Columns.PreferredWidthType = wdPreferredWidthAuto

Связанный контент