如何在Excel VBA中的Word.Documents.Add()中使用嵌入式dotx?

时间:2012-03-19 07:17:38

标签: excel excel-vba vba

我想在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

End Sub

1 个答案:

答案 0 :(得分: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