Word Autocorrect - AddRichText паразитные символы и строка для преобразования диапазона

Question

Еще одна сложная задача для вас, гуру!

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

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

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

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

FIRST - 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). Я попытался запустить очиститель поверх строки, чтобы удалить все непечатаемые символы, но там есть что-то, что просто не исчезнет и вызовет черный ящик в конце исправленного текста, когда используется автокоррекция. Я предполагаю, что это какой-то секретный код слова, который находится в ячейке таблицы. Попытка напечатать значение ASC для него возвращает 13, но удаление его не имеет эффекта (просто удаляет символы перед символом черного ящика).

ВТОРОЙ testAddRichText2

Затем я попробовал подход просто добавив курсив моей текстовой строки в моей рабочей модели, а затем использовать его с помощью метода AddRichText. Это попадает в отверстие, потому что AddRichText ожидает диапазон, и я не смог преобразовать текстовую строку в диапазон. Heres, что код

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 

Любая помощь на любом из них будет много appreciated

Приветствия

... Steve

Answer 1

Ваш первый пример, 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