从Excel编写到Word Activex文本框

Question

我有一个Excel应用程序，该应用程序通过基于表单的界面收集信息。这用于；

1. 填充工作簿中的值
2. 一个过程将打开一个Word文档（本质上是模板），并根据规则根据规则命名文件在一些输入数据上。 （到目前为止）

3. 然后，这个想法是将收集到的信息（从驱动此过程的Excel应用程序转移到打开并命名了相同的Word文档。具体来说，我打算用文档填充许多唯一命名的ActiveX文本框。

   ***这是我惨败的地方。

我已经在MSExcel VBA环境中的引用下启用了“ Microsoft Word 16.0对象库”。

鉴于我知道内容控件​​的名称/标题（ActiveX文本框是'内容控件'，不是吗？）。下面的代码是一个简化的示例，如果适用于该示例，我应该能够整理出更广泛的文档：

Sub trial()
Dim Word As Word.Application
Dim wdDoc As Word.Document
On error resume next
Set Word = New Word.Application
Set wdDoc = Word.Documents.Open("G:\CAPS Management Tool\Customer.docm")
Word.Application.Visible = True
Dim cc As Object
Set cc = ActiveDocument.SelectContentControlsByTitle(txt_PersonName) 'txt_PersonName is the control name
cc.Range.Text = "SUCCESS"  'Run-time error 438
                           'Object does not support property or method
Set cc = ActiveDocument.SelectContentControlsByTitle(txt_Address) 'txt_Address is the control name
cc.Range.Text = "SUCCESS"  'Run-time error 438
                           'Object does not support property or method
End Sub

有人能协助吗？我希望插入Word文档中有很多文本框。

提前感谢。

Answer 1

这里有一些技巧可以帮助您解决这个问题。

1. 除非确实需要，否则请不要使用On Error Resume Next。然后，当您使用它时，请尽快以On Error Goto 0重新启用错误捕获。否则，您将错过代码中的许多错误，并且很难说出正在发生什么。
2. 不要使用名称Word作为变量名。它为Word.Application保留，只会使编译器（和您）感到困惑。
3. 控件标题是文本字符串，因此必须将它们括在双引号中。
4. 我抛出了一个奖励Sub，它为您提供了一种打开新Word应用程序实例或附加到现有应用程序实例的快速方法。您会发现（尤其是在调试过程中）将打开并运行许多Word exe。

下面的示例代码还将您的“ SUCCESS”值分配给控件的操作分为一个单独的Sub。正是在简短的Sub中使用On Error Resume Next是适当的-并且与其余逻辑隔离-限制了它的范围。

Option Explicit

Sub trial()
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Set wdApp = AttachToMSWordApplication
    Set wdDoc = wdApp.Documents.Open("C:\Temp\Customer.docm")
    wdApp.Application.Visible = True
    TextToControl wdDoc, "txt_PersonName", "SUCCESS"
    TextToControl wdDoc, "txt_Address", "SUCCESS"
End Sub

Private Sub TextToControl(ByRef doc As Word.Document, _
                          ByVal title As String, _
                          ByVal value As String)
    Dim cc As ContentControl
    On Error Resume Next
    Set cc = doc.SelectContentControlsByTitle(title).Item(1)
    If Not cc Is Nothing Then
        cc.Range.Text = value
    Else
        Debug.Print "ERROR: could not find control titled '" & title & "'"
        '--- you could also raise an error here to be handled by the caller
    End If
End Sub

Public Function AttachToMSWordApplication() As Word.Application
    '--- finds an existing and running instance of MS Word, or starts
    '    the application if one is not already running
    Dim msApp As Word.Application
    On Error Resume Next
    Set msApp = GetObject(, "Word.Application")
    If Err > 0 Then
        '--- we have to start one
        '    an exception will be raised if the application is not installed
        Set msApp = CreateObject("Word.Application")
    End If
    Set AttachToMSWordApplication = msApp
End Function