Запись данных Excel в элементы управления содержимым Word без сообщений об ошибках - PullRequest
0 голосов
/ 20 декабря 2018

Этот вопрос касается использования элементов управления содержимым для перемещения значений данных из Excel в Word в VBA.Обратите внимание, что я включил «Библиотеку объектов Microsoft Word 16.0» по ссылкам в среде MSExcel VBA.

Мой проект должен отправить данные Excel в определенные места в документе Word.

ПРОБЛЕМА : Кажется, я не использую Contentcontrols должным образом и продолжаю получать ошибки времени выполнения. IЯ не нахожу много информации о.RTE-438

Объект не поддерживает этот метод

или RTE-424

Требуется объект

Описание того, что делает код : Есть две базовые книги с несколькими листами.В другой книге анализа используется каждая из них, запрограммированная с помощью VLOOKUP (INDIRECT ...),) для создания таблиц для отчетов, помещаемых в текстовый документ.Вариант используется для изменения вкладок в базовой книге.Анализ в основном CATS-DOGS = PETS.на каждом цикле таблицы, которые не являются информационными (без разницы между двумя базовыми рабочими книгами), пропускаются и анализируется следующая вкладка.Если таблица является информативной, то создается PDF.Отчет (документ Word) обновляется.Таблица добавлена ​​в отчет.По завершении рассматривается следующая вкладка или таблица оценки.

Sub CommandButton1_Click()

Dim Tabs(0 To 18) As Variant
Tabs(0) = "01"
Tabs(1) = "02"
Tabs(2) = "03"
Tabs(3) = "03"
Tabs(4) = "04"
Tabs(5) = "05"
Tabs(6) = "06"
Tabs(7) = "07"
Tabs(8) = "08"
Tabs(9) = "09"
Tabs(10) = "10"
Tabs(11) = "11"
Tabs(12) = "12"
Tabs(13) = "13"
Tabs(14) = "14"
Tabs(15) = "15"
Tabs(16) = "16"
Tabs(17) = "17"
Tabs(18) = "18"

Dim xlApp As Object
On Error Resume Next
    Set xlApp = GetObject("excel.applicaiton")
If Err.Number = 429 Then
    Err.Clear
    Set xlApp = CreateObject("excel.applicaiton")
End If
On Error GoTo 0

Dim controlThis As String ' the controlThis variable is to the address of the particular data unit that should be passed to a word.documents.contentcontrols to update the text in the word document based on the change in the actual data.

Dim NetworkLocation As String
NetworkLocation = "\\myServer\myFolder\mySubfolder\"

Dim CATS As String
CATS = "kittens.xlsx"
Excel.Application.Workbooks.Open FileName:=(NetworkLocation & "Other Subforder\ThisWway\" & CATS)

Dim DOGS As String
DOGS = "puppies.xlsx"
Excel.Application.Workbooks.Open FileName:=(NetworkLocation & "differentSubfolder\ThatWay\" & DOGS)
'Populates the array with analysis tables

Dim Temples As Object
Dim Template(3 To 9) As Variant
Template(3) = "\3\EVAL Table 3.xlsx"
Template(4) = "\4\EVAL Table 4.xlsx"
Template(5) = "\5\EVAL Table 5.xlsx"
Template(6) = "\6\EVAL Table 6.xlsx"
Template(7) = "\7\EVAL Table 7.xlsx"
Template(8) = "\8\EVAL Table 8.xlsx"
Template(9) = "\9\EVAL Table 9.xlsx"


Dim strXLname As String
Dim opener As Variant
    For Each opener In Template
        strXLname = NetworkLocation & "Other Subfolder\EVAL Tables\WonderPets" & opener
        Excel.Application.Workbooks.Open FileName:=strXLname

Dim currentDiffernce As Long
currentDifference = ActiveSheet.Cells(5, 6).Value
'This code cycles through the different EVAL Table templates

    ActiveSheet.Cells(1, 1).Value = CATS
    ActiveSheet.Cells(2, 1).Value = DOGS

        Dim k As Variant
        For Each k In Tabs
            controlThis = k & "-" & eval  'passes a string to the wdApp.contentcontrol
            ActiveSheet.Rows.Hidden = False
            ActiveSheet.Cells(1, 4).Value = k  'initialize k
            ActiveSheet.Calculate
            DoEvents
            currentDifference = ActiveSheet.Cells(5, 6).Value  'stop blank tables from being produced using the total delta in the preprogrammed spreadsheet
            If currentDifference = 0 Then  'since the total difference in the current analysis is 0 this bit of code skips to the next WonderPet
                Else
                    controlThis = k & "-" & opener  '(Was eval as variant used with thisTable array)passes a string to the wdApp.contentcontrol
                    Call PDFcrate  'Print the Table to a PDF file. Worked well and was made a subroutine.
                        Dim objWord As Object
                        Dim ws As Worksheet
                        'Dim cc As Word.Application.ContentControls
                        Set ws = ActiveWorkbook.Sheets("Sheet1")
                        Set objWord = CreateObject("Word.Application")
                        objWord.Visible = True
                        objWord.Documents.Open FileName:="myFilePath\Myfile.docx", noencodingdialog:=True ' change as needed

                        With objWord.ActiveDocument
                .ContentControls(controlThis & " cats").Range.Text = eval.ActiveSheet.Cells(5, 4) 'These are the updates to the report for each content control with the title. Substituting SelectContentControlsByTitle() gives RTE-424 'Object Required'
                .ContentControls(controlThis & " dogs").Range.Text = eval.ActiveSheet.Cells(5, 5)
                .ContentControls(controlThis & " pets").Range.Text = eval.ActiveSheet.Cells(5, 6)
                .ContentControls(controlThis & " Table).range. = 'Need to add the PDF to the report, perhaps using an RichTextConentConrols...additional suggestions welcomed (haven't researched it yet).
                        End With

                    Set objWord = Nothing
                    Word.Application.Documents.Close SaveChanges:=True 'Saves and Closes the document
                    Word.Application.Quit 'quits MS Word
            End If

        Next  'repeats for each tab with name "k" in the workbooks
Excel.Application.Workbooks(strXLname).Close
    Next  'repeat for each evalTable
Excel.Application.Workbooks(CATS).Close
Excel.Application.Workbooks(DOGS).Close

End Sub

Ответы [ 2 ]

0 голосов
/ 21 декабря 2018

Это исправило это ... зацикливание могло быть тем, что заставило меня отклеиться.Использование множественного числа ContentControls или единственного числа ContentControl не имело значения.Мой следующий трюк состоит в том, чтобы вставить таблицы в текстовый документ ... есть мысли?

Set wdDoc = Word.Application.Documents(wdDocReport)  
Dim evalData(0 To 2) As Variant  
evalData(0) = " CATS"  
evalData(1) = " DOGS"  
evalData(2) = " PETS"  

Dim j As Variant  
Dim i As Integer  
i = 4  
For Each j In evalData  
    Dim cc As Word.ContentControls   
    With Word.Application.Documents(wdDocReport)  
             .SelectContentControlsByTitle(controlThis & j).Item  (1).Range.Text = ActiveWorkbook.ActiveSheet.Cells(5, i).Value  
        i = i + 1  
    End With  
    Next  
Word.Application.Documents.Close SaveChanges:= True
Word.Application.Quit

В фокусе только один рабочий лист, поэтому ActiveWorkbook и ActiveWorksheet меня здесь не обидели

0 голосов
/ 20 декабря 2018

Элементы управления содержимым Word не могут быть получены с использованием строки в качестве значения индекса, как это могут делать другие вещи.Следующая строка из примера кода в вопросе не может работать:

.ContentControls(controlThis & " cats").Range.Text = eval.ActiveSheet.Cells(5, 4)

Единственное допустимое значение индекса для ContentControl - ID, то есть длинный номер (GUID), назначенный приложением Wordкогда генерируется ContentControl.

Причина этого заключается в том, что более одного элемента управления контентом могут иметь одинаковые Title (имя) и / или Tag.Поскольку эта информация не является уникальной, ее нельзя использовать для получения одного элемента управления содержимым.

Вместо этого код должен использовать Document.SelectContentControlsByTitle или Document.SelectContentControlsByTag.Они возвращают набор элементов управления контентом, которые соответствуют указанному критерию.Например:

Dim cc as Word.ContentControls ' As Object if late-binding is used
With objWord.ActiveDocument
    Set cc = .SelectContentControlsByTitle(controlThis & " cats")
    'Now loop all the content controls in the collection to work with individual ones
End With

Если есть уверенность, что есть только один элемент управления содержимым с Title, или требуется только первый, тогда можно сделать это:

Dim cc as Word.ContentControl ' As Object if late-binding is used
With objWord.ActiveDocument
    Set cc = .SelectContentControlsByTitle(controlThis & " cats").Item(1)
    cc.Range.Text = eval.ActiveSheet.Cells(5, 4)
End With

Совет 1: Использование ActiveDocument не считается хорошей практикой для Word.Как и в случае ActiveCell (или чего-либо еще) в Excel, нет уверенности в том, что «активная» вещь - это та, которой следует манипулировать.Более надежным является использование объекта, который в этом случае может быть назначен непосредственно открываемому документу.Основываясь на коде в вопросе:

Dim wdDoc as Object 'Word.Document
Set wdDoc = objWord.Documents.Open(FileName:="myFilePath\Myfile.docx", noencodingdialog:=True)
With wdDoc  'instead of objWord.ActiveDocument

Совет 2. Поскольку код в вопросе предназначен для нескольких элементов управления контентом, а не для объявления нескольких объектов управления контентом, может быть более эффективно поместить заголовки и значения вмассив и цикл, что.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...