使用Excel中的嵌入式Word文档(后期绑定)

时间:2019-05-08 05:57:49

标签: excel vba ms-word

我想知道是否有可能删除对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 个答案:

答案 0 :(得分:1)

如果您在Office 2013系统上设置引用,则它将与Office 2016及更高版本一起使用,而无需进行任何更改。