Файл вставки слов VBA изменяет стиль (шрифт, размер…) закладки и добавляет новую строку

#vba #ms-word

Вопрос:

Я пытаюсь заполнить документ Word обычными текстовыми файлами в VBA. Вот что у меня есть :

  1. В документе Word есть закладки с текстом по умолчанию внутри (это помогает мне убедиться, что все закладки заменены).
  2. Следующий VBA выполняет работу по вставке того, что находится внутри файла txt, в закладку
 strt = bookmark.Range.Start
bookmark.Select
Selection.InsertFile Filename:=Filename, ConfirmConversions:=False, Link:=False, Attachment:=False
Selection.Bookmarks.Add Name:=bookmarkname, Range:=ActiveDocument.Range(strt, Selection.Range.End)
 

Основная проблема заключается в том, что после запуска VBA имя шрифта, размер шрифта, маркированные точки (если таковые имеются)… меняются на что-то другое (Курьерские Новые 10,5 очка). Я воссоздаю закладку, чтобы иметь возможность запускать макрос несколько раз, если текстовые файлы будут изменены.

Я нашел уродливое (имхо) решение:

  1. Сохранение имени стиля и применение его после файла вставки. Для маркированных пунктов применение стиля не устанавливает правильный шрифт и размер, следовательно, 2 последние строки
 strt = bookmark.Range.Start
bookmark.Select
myStyle = (Selection.Style)
Selection.InsertFile Filename:=Filename, ConfirmConversions:=False, Link:=False, Attachment:=False
Selection.Bookmarks.Add Name:=bookmarkname, Range:=ActiveDocument.Range(strt, Selection.Range.End)
ActiveDocument.Range(strt, Selection.Range.End).Style = myStyle
ActiveDocument.Range(strt, Selection.Range.End).Font.Name = "Calibri"
ActiveDocument.Range(strt, Selection.Range.End).Font.Size = 11
 

У вас есть какие-нибудь идеи сделать что-то более «профессиональное»?

Другая проблема заключается в том, что файл вставки всегда добавляет новую строку в конце, даже если в конце файла нет новой строки. Есть идея предотвратить это или, по крайней мере, удалить его после вставки?

Спасибо за любую идею помочь мне!

Ответ №1:

У обычных текстовых файлов нет стиля. Они будут использовать любой стиль, примененный к выделению, в которое вы вставляете файл. Создайте стиль, который будет выглядеть так, как вы хотите, чтобы окончательный текст выглядел, примените его к получающему документу, а затем повторно запустите свой код.

Попробуйте избавиться от привычки программировать объект выбора. Это медленно и ненадежно. Диапазоны лучше, чем выбор. Вот введение Microsoft в диапазоны: Работа с объектами диапазона

Вместо использования файла вставки вы можете использовать диапазон.Текст для вставки текста:

 Sub Text2Doc()
    Dim iFreeFileNum As Integer
    Dim strPath As String
    Dim strFileContent As String

    strPath = "C:Test.txt"
    'Get the next file number available for use by the FileOpen function
    iFreeFileNum = FreeFile
    Open strPath For Input As iFreeFileNum
    strFileContent = Input(LOF(iFreeFileNum), iFreeFileNum)
    ActiveDocument.Bookmarks("BookmarkName").Range.Text = strFileContent
    Close iFreeFileNum
End Sub
 

Пометка в конце абзаца не будет добавлена.

Комментарии:

1. Спасибо! Обе проблемы были решены (стиль не изменился, и не добавлена отметка в конце абзаца), и это определенно быстрее! Это создает новую проблему : мои файлы содержат символы UTF8 (французские акценты), и они вставлены неправильно (это было правильно с моим «решением»). Вы знаете, как я мог бы это решить?

2. Это новый вопрос. Пожалуйста, начните новую тему с подробностей. Я был бы признателен за поддержку, если бы этот ответ был полезен. Спасибо!

3. Мне удалось изменить кодировку в сценарии создания файлов, так что результат в порядке. Я добавил Set prevRange = ActiveDocument.Bookmarks(bookmarkname).Range в начале и ActiveDocument.Bookmarks.Add bookmarkname, prevRange в конце, чтобы воссоздать закладки.

Ответ №2:

Для меня в будущем или для любого, у кого есть такая же проблема с UTF-8, вот мое решение в VBA. Это слияние между принятым ответом от @john-korchok и некоторым кодом, найденным здесь: Чтение и запись файла UTF8 в VBA

 Dim bookmark As bookmark
Dim Filename As String
Dim fs
Dim bookmarkname As String
Dim rngBookmark As Word.Range
Dim objStream

Set objStream = CreateObject("ADODB.Stream")
Set fs = CreateObject("Scripting.FileSystemObject")

For Each bookmark In ActiveDocument.Bookmarks
    If bookmark.Name <> bookmarkname Then ' Avoids infinity loop because of Selection.Bookmarks.Add
        bookmarkname = bookmark.Name
        Filename = Path   bookmarkname   ".txt"
        If fs.FileExists(Filename) Then
            ' Records the bookmarks position to recreate it after
            Set rngBookmark = ActiveDocument.Bookmarks(bookmarkname).Range
            objStream.Charset = "utf-8"
            objStream.Open
            objStream.LoadFromFile (Filename)
            rngBookmark.Text = objStream.ReadText()
            ' Recreation of the bookmark
            ActiveDocument.Bookmarks.Add bookmarkname, rngBookmark
            objStream.Close
        End If
    End If
Next