Запись из Excel в текстовое поле Word Activex

Question

У меня есть приложение Excel, которое собирает информацию через интерфейс на основе форм. Это используется для:

1. Заполнения значений в книге
2. Процедура открывает документ Word (по сути, шаблон) и называет файл в соответствии с правилами на основе некоторых входных данных . (Хорошо)

3. Идея состоит в том, чтобы перенести собранную информацию (из приложения Excel, управляющего этим процессом) в тот же документ Word, открытый и названный. В частности, я намереваюсь заполнить несколько текстовых полей ActiveX с уникальными именами с помощью документа.

   *** Вот где я с треском провалился. Библиотека объектов Word 16.0 »по ссылкам в среде MSExcel VBA.

   Учитывая, что я знаю имя / заголовок элемента управления содержимым (текстовое поле 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 есть много текстовых полей, которые я sh хочу подключить.

   Заранее спасибо.

Answer 1

Хорошо, я продолжал копать (я не люблю принимать поражение) и обнаружил, что вся моя предпосылка была неправильной! Элементы управления ActiveX в Word считаются «InlineShapes», а не «ContentControls». Но результаты, которые я читал при поиске inte rnet, сбили меня с толку (я не претендовал на звание самого острого инструмента в сарае).

Как только я это понял, еще несколько копаний дали ответ (см. ниже).

Итак, сначала перечислим 3 элемента управления в моем документе (и их индекс) со следующим Sub

Sub ListActiveXControls()
Dim i As Integer
i = 1
Do Until i > ActiveDocument.InlineShapes.Count
Debug.Print ActiveDocument.InlineShapes(i).OLEFormat.Object.Name & "    Control Index = " & i
i = i + 1
Loop
End Sub

Теперь, переходя к EXCEL, я использовал следующее:

Sub trial()
Dim Word As Word.Application
Dim wdDoc As Word.Document
Set Word = New Word.Application
Set wdDoc = Word.Documents.Open("G:\CAPS Management Tool\Customer.docm")
Word.Application.Visible = True
debug.print "ActiveDocument Name is : " & ActiveDocument.Name 
' Result = Nothing
' Allowing the code to continue without the pause caused the operation to fail
Application.Wait (Now + TimeValue("0:00:10")) ' See text below, would not work without pause
wdDoc.Activate
' Begin set ActiveX control values. In this instance,
' The first line corresponds to 'Textbox1'
ActiveDocument.InlineShapes(1).OLEFormat.Object.Text = "Success"
' The second line corresponds to 'Textbox2'
ActiveDocument.InlineShapes(2).OLEFormat.Object.Text = "Success"
' The third line corresponds to 'ChkBox1'
ActiveDocument.InlineShapes(3).OLEFormat.Object.Value = True
End Sub

По какой-то причине без команды «Ждать» операция не выполняется. Проходя через, если нет паузы, ActiveDocument кажется пустым, не знаю почему. Это происходит с документом с 2 элементами управления ActiveX или 165 элементами управления ActiveX, и необходимое время ожидания составляет 10 секунд на моем P C. Между прочим, установка почти 150 контрольных значений занимала всего несколько секунд после завершения периода ожидания.

Если кто-нибудь знает, почему, казалось бы, требуется «Подождите», мне было бы интересно узнать!

Answer 2

Вот несколько советов, которые помогут вам решить эту проблему.

1. Не используйте On Error Resume Next, если он вам действительно не нужен. А затем, когда вы все-таки воспользуетесь им, как можно быстрее повторно включите перехват ошибок с помощью On Error Goto 0. В противном случае вы упустите много ошибок в своем коде и вам будет сложно понять, что происходит.
2. Не используйте имя Word в качестве имени переменной. Он зарезервирован для Word.Application и только запутает компилятор (и вас).
3. Заголовки элементов управления представляют собой текстовые строки, поэтому вы должны заключить их в двойные кавычки.
4. I ' Мы добавили бонус Sub, который дает вам быстрый способ либо открыть новый экземпляр приложения Word, либо присоединиться к существующему экземпляру приложения. Вы обнаружите, что (особенно во время отладки) будут открыты и запущены десятки Word exe. Sub. В этом коротком значении Sub уместно использование On Error Resume Next - и оно изолировано от остальной части logi c - ограничивая его объем.

   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