Пытаетесь вставить таблицу из Excel в Word, но получаете сообщение об ошибке «файл заблокирован для редактирования ...» самостоятельно?

Question

Я пытаюсь создать код, который считывает динамическую таблицу Excel в существующий документ Word и изменяет некоторые переменные в документе (например,% Username%)

Приведенный ниже код дает мне «Заблокировано»для редактирования "ошибка самостоятельно, но это не так.

Может кто-нибудь увидеть, что я должен изменить в коде?

Код:

Sub Export_Table_Word()

    'Word objects.
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim wdbmRange As Word.Range

    'Excel objects.
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim rnReport As Range

    'Path of Word Template
    Dim stPathTemplate As String
    Dim stPathSave As String

    'Dynamic Replace variables
    Dim UserName As String
    Dim StrFind
    Dim StrRepl As String

    'Loop variable
    Dim i As Long

    Dim msWord As Object
    Set msWord = CreateObject("Word.Application")

    'Define replacement variables
    UserName = Application.UserName

     sFirst = Split(UserName, " ")(0) 'Firstname                         'sFirst = Split(UserName, ",")(1) 'Firstname
    sLast = Split(UserName, " ")(1)  'Lastname
    sUserName = Left(sFirst, 1) & sLast  'First letter of firstname and lastname
    sFullName = sFirst & " " & sLast  'Full name

    StrFind = "%User_Name%,%Full_name%, %Date%"   'Strings to be replaced in the word document
    StrRepl = sUserName & "*" & sFullName & "*" & " " & Date    'Replaced by

    'Initialize Path word template
    stPathTemplate = "C:\Users\xxx\Desktop\VBA_TEST\VBA_Automation.docx"
    stPathSave = "C:\Users\xxx\Desktop\VBA_TEST\Finished.docx"

    'Initialize the Excel objects.
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets(1)
    Set rnReport = wsSheet.Range("D2:D7")

    'Initialize the Word objets.
    Set wdApp = New Word.Application
    Set wdDoc = wdApp.Documents.Open(stPathTemplate)
    Set wdbmRange = wdDoc.Bookmarks("Report").Range

    'If the macro has been run before, clean up any artifacts before trying to paste the table in again.
    On Error Resume Next
    With wdDoc.InlineShapes(1)
        .Select
        .Delete
    End With
    On Error GoTo 0

    'Turn off screen updating.
    Application.ScreenUpdating = True

    With wdDoc
        .Visible = True
        .Documents.Open (stPathTemplate)     
        .Activate

        With .ActiveDocument.Content.Find
             .ClearFormatting
             .Replacement.ClearFormatting

            For i = 0 To UBound(Split(StrFind, ",")) 'Loop to replace all the defined dynamic strings
             .Text = Split(StrFind, ",")(i)
             .Replacement.Text = Split(StrRepl, "*")(i)
             .Execute Replace:=wdReplaceAll
            Next i

            .Forward = True
            .Wrap = 1               'FindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False

            .Execute Replace:=2    'wdReplaceAll (WdReplace Enumeration)       
        End With
    End With

     'Copy the report to the clipboard.
    rnReport.Copy

    'Select the range defined by the "Report" bookmark and paste in the report from clipboard.     
    With wdbmRange
        .Select
        .Paste    
    End With

    'Save and close the Word doc.
    With wdDoc
        '.Save
        .SaveAs2 Filename:=stPathSave, _
    FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False

        .Close
    End With

    'Quit Word.
    wdApp.Quit

    'Null out your variables.
    Set wdbmRange = Nothing
    Set wdDoc = Nothing
    Set wdApp = Nothing

    'Clear out the clipboard, and turn screen updating back on.
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With

    MsgBox ("Done") 
End Sub