如何在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