Работа со встроенным документом Word из Excel (позднее связывание) - PullRequest
0 голосов
/ 08 мая 2019

Мне интересно, есть ли возможность удалить ссылку на библиотеку объектов Microsoft Word 16.0 и отредактировать код так, чтобы она работала как в Office 2013, так и в Office 2016?

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

Sub opentemplateWord()
    Dim sh As Shape
    Dim objWord As Object, objNewDoc As Object ''Word.Document
    Dim objOL As OLEObject
    Dim wSystem As Worksheet
    Dim cell As Range
    Dim wdRng As Object 'Word.Range
    Dim xlRng As Excel.Range
    Dim tempFolderPath As String
    Dim filePath As String
    Dim fileTitle As String

    Set wSystem = ThisWorkbook.Sheets("Templates")
        ''The shape holding the object from 'Create from file'
        ''Object 2 is the name of the shape
    Set sh = wSystem.Shapes("LetterTemplate")
         ''The OLE Object contained
    Set objOL = sh.OLEFormat.Object
         'Instead of activating in-place, open in Word
    objOL.Verb xlOpen
    Set objWord = objOL.Object 'The Word document

    Dim objUndo As Object 'Word.UndoRecord
        'Be able to undo all editing performed by the macro in one step
    Set objUndo = objWord.Application.UndoRecord
    objUndo.StartCustomRecord "Edit In Word"

    With objWord
        'Cover page
    .Bookmarks("CoverPage").Range.Text = ThisWorkbook.Sheets("Other Data").Range("AK4").Value

    Set xlRng = ThisWorkbook.Sheets("Letter").Range("G3", ThisWorkbook.Sheets("Offer Letter").Range("G" & Rows.Count).End(xlUp))

    Set wdRng = .Range.Characters.Last

    For Each cell In xlRng
        wdRng.InsertAfter vbCr & cell.Offset(0, -5).Text
        Select Case LCase(cell.Value)

    Case "signature"
       Worksheets("Contact database").Shapes("Signature").Copy
        With wdRng
        .Paragraphs.Last.Range.Paste (wdPasteDefault)
        End With

    If ActiveDocument.TablesOfContents.Count = 1 Then _
  ActiveDocument.TablesOfContents(1).Update

        objWord.SaveAs2 Environ$("USERPROFILE") & "\Desktop\" & _
        ThisWorkbook.Sheets("Other Data").Range("AU2").Value & ".docx"

        objUndo.EndCustomRecord
        Set objUndo = Nothing
        objWord.Undo
        .Application.Quit False

    End With
    Set objWord = Nothing
End Sub

1 Ответ

1 голос
/ 08 мая 2019

Если вы установите ссылку в системе Office 2013, она будет работать с Office 2016 и более поздними версиями без необходимости что-либо менять.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...