Добавление форматированных записей из таблицы в документе в библиотеку автозамены

Я пытаюсь добавить отформатированные записи из таблицы в документе MSWord 2016 в библиотеку автозамены (которая хранится в normal.dotx, как обычно для форматированных записей).

В документе у меня есть таблица, содержащая два столбца, в левом столбце есть короткий текст, а в правом столбце - отформатированный длинный текст для записей автозамены.

У меня есть рабочий макрос для хранения неформатированного текста с использованием строки AutoCorrect.Entries.Add Name:=ShortText, Value:=LongText.
Я пытаюсь изменить его, чтобы использовать функцию AutoCorrect.Entries.AddRichText ShortText, longtext, которая затем должна подбирать свойства шрифта и курсива в таблице.

Я пробовал два метода.

ПЕРВЫЙ - testAddRichText1

Вот код (удалена часть косметики)

Sub testAddRichText1()
    Set oDoc = ActiveDocument
    For i = 1 To oDoc.Tables(2).Rows.Count
        If oDoc.Tables(2).Rows(i).Cells(1).Range.Characters.Count > 1 Then
            ShortText = oDoc.Tables(2).Cell(Row:=i, Column:=1)
            ShortText = Left(ShortText, Len(ShortText) - 2) 'remove the trailing CR and LF
            longtext = oDoc.Tables(2).Cell(Row:=i, Column:=2)
            StatusBar = "Adding " & ShortText & " = " & longtext.Text
            AutoCorrect.Entries.AddRichText ShortText, longtext
        End If
    Next i
    MsgBox "done"
End Sub

Используя этот код, в конце текста, извлеченного из ячейки, есть ряд непечатных символов, в основном Chr (13) 's. Я попытался запустить очиститель над строкой, чтобы удалить все непечатаемые символы, но есть что-то, что просто не исчезнет и вызывает черный ящик в конце исправленного текста при использовании автозамены. Я предполагаю, что это какой-то секретный код слова, который находится в ячейке таблицы. Попытка распечатать его значение ASC возвращает 13, но его удаление не имеет никакого эффекта (просто удаляются символы перед символом черного ящика).

ВТОРОЙ testAddRichText2

Я попытался добавить курсив к моей текстовой строке в своей рабочей модели, а затем использовать его с методом AddRichText. AddRichText ожидает диапазон, а мне не удалось преобразовать текстовую строку в диапазон.

Вот этот код

Sub testAddRichText2()
    Set oDoc = ActiveDocument
    Dim LongTextrng As Range
    For i = 1 To oDoc.Tables(2).Rows.Count
        If oDoc.Tables(2).Rows(i).Cells(1).Range.Characters.Count > 1 Then
            ShortText = oDoc.Tables(2).Cell(Row:=i, Column:=1)
            ShortText = Left(ShortText, Len(ShortText) - 2)
            longtext = oDoc.Tables(2).Cell(Row:=i, Column:=2).Range
            longtext = Left(longtext, Len(longtext) - 2)
            LongTextrng.Text = longtext 'Fails
            LongTextrng.Italic = True
            StatusBar = "Adding " & ShortText & " = " & longtextrng.Text
                AutoCorrect.Entries.Add Name:=ShortText, Value:=LongTextrng
        End If
    Next i
    MsgBox "done"
End Sub

vba ms-word autocorrect
person SteveParry    schedule 30.09.2016    source источник
comment
Вы изобретаете колесо, предлагая два бесплатных предложения MVP. Автозамена2007.zip Джея Фридмана, jay-freedman.info и менеджер утилиты резервного копирования автозамены Грега Макси. gregmaxey.com/word_tip_pages/autocorrect_utility_manager.html ---- Если нет причин не используйте один из них, я бы использовал их, а не пытался написать свой собственный код. Код Джея не скрывается.   -  person Charles Kenyon    schedule 05.01.2021
comment
Эти утилиты использовались в тысячах систем.   -  person Charles Kenyon    schedule 05.01.2021
comment
Спасибо, Чарльз. Можно было сделать с этим в 2016 году, когда я изо всех сил пытался заставить это работать :-)   -  person SteveParry    schedule 07.01.2021
comment
Тем не менее, посмотрите на код в утилите Джея. Это может быть полезно. Он работал над этим более 15 лет и начал с кода Microsoft. Я считаю, что у него были тысячи пользователей, и он несколько раз настраивал его, чтобы убедиться, что он работает во всех системах.   -  person Charles Kenyon    schedule 07.01.2021

Ответы (1)


arrow_upward
2
arrow_downward

Ваш первый пример, testAddRichText1, почти правильный. Это не удается, потому что, хотя вы осознали необходимость удаления завершающих символов из ShortText, вы не сделали того же для longText.

Чтобы сократить диапазон, вы перемещаете конец диапазона с помощью метода MoveEnd. В этом случае вам нужно переместить конец диапазона на один символ назад, чтобы удалить маркер конца ячейки.

Во втором примере, testAddRichText2, код не работает, потому что вы неправильно присвоили диапазон переменной LongTextrng. При присвоении значения объектной переменной вам необходимо использовать команду Set, например:

Set objVar = object

Это не привело к неудаче с вашей первой попытки, потому что LongText не был объявлен и, следовательно, предполагается, что это вариант.

Приведенный ниже код будет работать для вас:

Sub AddRichTextAutoCorrectEntries()
    Dim LongText                    As Range
    Dim oRow                        As Row
    Dim ShortText                   As String

    For Each oRow In ActiveDocument.Tables(2).Rows
        If oRow.Cells(1).Range.Characters.Count > 1 Then
            ShortText = oRow.Cells(1).Range.Text
            ShortText = Left(ShortText, Len(ShortText) - 2)
            'assign the range to the variable
            Set LongText = oRow.Cells(2).Range
            'move the end of the range back by 1 character
            LongText.MoveEnd wdCharacter, -1
            StatusBar = "Adding " & ShortText & " = " & LongText.Text
            AutoCorrect.Entries.AddRichText Name:=ShortText, Range:=LongText
        End If
    Next oRow
End Sub
person Timothy Rylatt    schedule 01.10.2016
comment
Спасибо, Тим. Это круто и отлично работает! Спасибо за объяснение и более элегантное кодирование! Ура ... Стив - person SteveParry; 01.10.2016