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

我想在Excel工作簿中embedded单词模板，以便用户可以单击生成报告button并使用单词模板打开一个新文档。

以下代码直接编辑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，并允许对模板进行更改，这是不受欢迎的，因为模板包含支持自动生成报告的格式和标记。

要直接回答您的问题，您可以按照以下方式打开embedded的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来获取用户的临时文件夹，然后将embedded的文档保存到该文件夹​​。 一旦文件被保存，然后我使用.Add创build新的文件。 另外，我正在使用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