如何在Excel VBA中使用Word.Documents.Add（）中的嵌入式dotx？

Question

我想在Excel工作簿中嵌入單詞模板，以便用戶可以單擊生成報告按鈕並讓單詞使用單詞模板打開新文檔。

下面的代碼直接編輯dotx並允許對模板進行更改，這是不受歡迎的，因爲模板包含支持自動生成報告的格式和標記。

Public Sub ExportReportEmbedded() 

Set curSheet = ActiveSheet 
Application.ScreenUpdating = False 

Dim wdApp As Word.Application, wdDoc As Word.Document 
Set ole = Sheets("Report").Shapes("Object 4").OLEFormat 
ole.Activate 
' rather than activating it, I want to use the dotx in a new Word.Documents.Add(). 
' But how? 
' wdApp.Documents.Add(ole.???) 
curSheet.Activate 
Set wdDoc = ole.Object.Object 

Set q = Sheets("Report") 
With wdDoc.ContentControls 
    For i = 1 To 62 Step 1 
     .Item(i).Range.Text = q.Range("b" & i) 
    Next 
End With 

Application.ScreenUpdating = True 

結束子

Answer 1

在下面的代碼直接編輯DOTX並允許改變到模板，這是不可取的，因爲該模板包含格式和標記支持作出自動生成報告。

直接回答你的問題，你可以通過以下方式打開嵌入式DOTX使模板本身沒有被打開，但基於模板的另一個Word文檔。

希望這是你想要的嗎？

Sub Sample() 
    Dim shp As Shape 

    Set shp = Sheets("Report").Shapes.Range(Array("Object 4")) 
    shp.Select 
    Selection.Verb Verb:=xlPrimary 
End Sub 

隨訪

試試這個。我正在使用GetTempPath API來獲取用戶的臨時文件夾，然後將嵌入式文檔保存到該文件夾​​。保存文檔後，我使用.Add創建新文件。此外，我正在使用MS Word的Late Binding，因此您不需要設置任何對MS Word對象庫的引用。請讓我知道，如果您有任何疑問:)

Private Declare Function GetTempPath Lib "kernel32" _ 
Alias "GetTempPathA" (ByVal nBufferLength As Long, _ 
ByVal lpBuffer As String) As Long 

Public Sub ExportReportEmbedded() 
    Dim oWordApp As Object, oWordDoc As Object, objWord As Object 
    Dim FlName As String 
    Dim sh As Shape 
    Dim objOLE As OLEObject 

    '~~> Decide on a temporary file name which will be saved in the 
    '~~> users temporary folder 
    FlName = GetTempDirectory & "\Template.dotx" 

    Set sh = Sheets("Report").Shapes("Object 4") 

    sh.OLEFormat.Activate 

    Set objOLE = sh.OLEFormat.Object 

    Set objWord = objOLE.Object 

    '~~> Save the file to the relevant temp folder 
    objWord.SaveAs2 fileName:=FlName, FileFormat:=wdFormatXMLTemplate 

    '~~> Establish an Word application object 
    On Error Resume Next 
    Set oWordApp = GetObject(, "Word.Application") 

    If Err.Number <> 0 Then 
     Set oWordApp = CreateObject("Word.Application") 
    End If 
    Err.Clear 
    On Error GoTo 0 

    oWordApp.Visible = True 

    '~~> Create new document based on the template 
    Set oWordDoc = oWordApp.Documents.Add(Template:=FlName, NewTemplate:=False, DocumentType:=0) 

    '~~> Close the actual template that opened 
    objWord.Close savechanges:=False 

    '~~> Rest of the code 
    '~~> now you can work with oWordDoc. This will not save the actual template 

    '~~> In the end Clean Up (Delete the template saved in the temp directory) 
    Kill FlName 
End Sub 

'~~> Function to get the user's temp directory 
Function GetTempDirectory() As String 
    Dim buffer As String 
    Dim bufferLen As Long 
    buffer = Space$(256) 
    bufferLen = GetTempPath(Len(buffer), buffer) 
    If bufferLen > 0 And bufferLen < 256 Then 
     buffer = Left$(buffer, bufferLen) 
    End If 
    If InStr(buffer, Chr$(0)) <> 0 Then 
     GetTempDirectory = Left$(buffer, InStr(buffer, Chr$(0)) - 1) 
    Else 
     GetTempDirectory = buffer 
    End If 
End Function