Написать текст и закладки в шаблон Word, встроенный в рабочую книгу - PullRequest
0 голосов
/ 30 января 2019

(Этот вопрос является продолжением , как работать с документом, встроенным в рабочую книгу Excel в интерфейсе приложения Word (вместо на месте). Причина, по которой это необходимо, заключается в том, чтобывозможность сохранить результат как независимый документ.)

Этот код делает то, что нужно сделать.Открытие встроенного шаблона Word, его заполнение и сохранение в новой копии.Единственная часть, которая не работает, это .Application.Quit False.Ошибка при получении Word: «Microsoft Word перестал работать».Что может быть возможной причиной этого сбоя?

Sub opentemplateWord()
Dim sh As Shape
Dim objOLE As OLEObject
Dim objWord As Object 'Word.Document
Dim objRng As Object 'Word.Range
Dim objUndo As Object 'Word.UndoRecord
Dim cell As Excel.Range
Dim xlRng As Excel.Range
Dim xlSht As Worksheet


Set xlSht = Sheets("Main")

With xlSht
  Set xlRng = .Range("E1", .Range("E" & Rows.Count).End(xlUp))
End With

''The shape holding the object from 'Create from file'
''Object 2 is the name of the shape
Set sh = Worksheets("Templates").Shapes("WordFile")
''Activate the contents of the object
sh.OLEFormat.Activate
Set objOLE = sh.OLEFormat.Object
Set objWord = objOLE.Object

With objWord
  Set objRng = .Range.Characters.Last
  Set objUndo = .Application.UndoRecord
  objUndo.StartCustomRecord ("Doc Data")
  Set xlSht = Sheets("Main")
  .Bookmarks("ProjectName1").Range.Text = xlSht.Range("B10").Value
  .Bookmarks("ProjectName2").Range.Text = xlSht.Range("B11").Value
  .Bookmarks("ProjectName3").Range.Text = xlSht.Range("B12").Value
  .Bookmarks("ProjectName4").Range.Text = xlSht.Range("B13").Value
  .Bookmarks("ProjectName5").Range.Text = xlSht.Range("B14").Value

  For Each cell In xlRng
    objRng.InsertAfter vbCr & cell.Offset(0, -1).Text
     Select Case LCase(cell.Value)
        Case "title"
          objRng.Paragraphs.Last.Style = .Styles("Heading 1")
        Case "main"
          objRng.Paragraphs.Last.Style = .Styles("Heading 2")
        Case "sub"
          objRng.Paragraphs.Last.Style = .Styles("Heading 3")
        Case "sub-sub"
          objRng.Paragraphs.Last.Style = .Styles("Heading 4")
        Case "par"
          objRng.Paragraphs.Last.Style = .Styles("Normal")
    End Select
  Next cell
  Set xlSht = Sheets("Main")
  .SaveAs2 ActiveWorkbook.Path & "\" & _
    xlSht.Range("B2").Value & ", " & _
    xlSht.Range("B3").Value & "_" & _
    xlSht.Range("B4").Value & "_" & _
    xlSht.Range("B5").Value & ".docx"
  objUndo.EndCustomRecord
  .Undo
  .Application.Quit False '<---- Please close Word application
End With
Set objWord = Nothing '<---- Please free up objWord
End Sub

1 Ответ

0 голосов
/ 30 января 2019

При автоматизации другого приложения Office память может «связываться» по разным причинам.Одним из важных факторов является управление объектами , которые использовался кодом.В какой-то момент их нужно «освободить», чтобы освободить память.Если их неправильно утилизировать, они могут оставить приложение открытым (даже если оно не видно) и вызвать проблемы.

Одной из возможных проблем может быть многократное создание экземпляра xlSheet,Поскольку ему всегда присваивается один и тот же лист, это нужно сделать только один раз.Если вы хотите повторно использовать объект (для другого объекта) и у кода возникают проблемы, сначала установите для этого объекта значение Nothing, прежде чем назначать ему другой объект.(Обычно это не нужно, но иногда это помогает.)

Код в вопросе выполняется в Excel и использует несколько объектов Word.Эти объекты Word могут стать проблемой (объекты Excel выйдут из области видимости после завершения процедуры).Следовательно, хорошей практикой кодирования является установка объекта на Nothing, как только он больше не нужен.

Пример кода из вопроса для иллюстрации:

  With objWord  'a Word document
     objUndo.EndCustomRecord
    .Undo
    Set objUndo = Nothing '<---- Release Word objects in Excel code
    Set objRng = Nothing
    .Application.Quit False '<---- Please close Word application
  End With
  Set objWord = Nothing '<---- Please free up objWord
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...