excel - 如何在 Excel 的 Word.Documents.Add() 中使用嵌入的 dotx？

Question

我想在 Excel 工作簿中嵌入一个 word 模板，以便用户可以单击生成报告按钮并让 word 使用 word 模板打开一个新文档。
以下代码直接编辑 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
End Sub

Answer 1

The below code directly edits the dotx and allows changes to be made to the template, which is undesirable as the template contains formatting and markup that supports the auto-report generation.

直接回答你的问题，你可以通过以下方式打开嵌入的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创建新文件。此外，我正在使用后期绑定(bind)与 MS Word，因此您无需设置对 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