«Некоторые элементы управления не могут быть добавлены в это местоположение» при добавлении более одного выпадающего списка в ячейку таблицы

Question

Я создаю функцию в моей базе данных доступа, которая создает календарь с использованием шаблона с готовой таблицей в нем. Он будет иметь раскрывающийся список «статус» для каждой отправки в определенный день. Мне удалось создать раскрывающийся список для каждой ячейки таблицы, но как только я переместил оператор set внутри этого цикла do-while, я получил следующее слово в слове:

Некоторые элементы управления не могут быть добавлены в это местоположение

с последующим:

Ошибка времени выполнения «4198»: сбой команды

В доступе

Я нашел этот вопрос, упомянув проблемы с элементами управления контентом Добавление элемента управления содержимым динамически вызывает исключение

Но это не в VBA. Возможно ли, что здесь есть какая-то эквивалентная проблема или это тупик?

For i = 1 + 1 To NUMBER_OF_WEEKS + 1 '16 + 1

        For j = 1 To NUMBER_OF_DAYS_IN_THE_WEEK ' 7

             Do While Not rst.EOF ' rst is a DAO.Recordset of shipping dates ordered chronologicly. multiple items can ship the same day
                If rst![Ship] <> currDay Then ' if nothing left to ship this day, move to next cell/row
                    Exit Do
                End If

                doc.Tables(1).Cell(i, j).Range.InsertAfter vbCrLf 'supposed to add a new line between dropdown lists

                Set DDown = doc.Tables(1).Cell(i, j).Range.ContentControls.Add(wdContentControlDropdownList) 'This line fails upon adding a second dropdown to a cell

                'Add items to dropdown
                DDown.DropdownListEntries.Add "Shipping within 7 days"
                DDown.DropdownListEntries.Add "On schedule"
                DDown.DropdownListEntries.Add "On Hold"

            Loop

        'move to the next day
        currDay = currDay + 1
    Next j
Next i

Я ожидал получить несколько раскрывающихся списков для каждого дня, но это приводит к одному выпадающему списку во 2-й ячейке первого ряда (не может быть отправлен по воскресеньям, поэтому он пропускает первую ячейку каждого ряда), прежде чем сказать что Контент-контроль не может быть добавлен

Answer 1

Сложность при размещении элементов в таблице заключается в том, чтобы убедиться, что целевая позиция находится в ячейке, а не в структурах таблицы или, в случае элементов управления содержимым, в элементе управления содержимым.Работа с Range объектами облегчает управление.

Обратите внимание, что из кода в вопросе неясно, когда i и j увеличиваются, поэтому может потребоваться корректировка подходафактические циклы выполняются.Поскольку у меня нет вашей базы данных, мое тестирование проводилось вне контекста, но что-то вроде этого, встраивая его в код вопроса.

Сначала объявляем объекты для работы с целевой таблицей, ячейкой и диапазоном.Ключ заключается в том, чтобы свернуть целевой диапазон перед вставкой нового содержимого.

Существует также «странность» при вставке многочисленных элементов управления содержимым в цикл, что Word внезапно смешает фактическую цель Range с таковой из последнегоКонтент управления вставлен.По этой причине код выбирает цель Range в каждом цикле, что, похоже, помогает Word сохранять ясность ...

Dim tbl As Word.Table, cel As Word.Cell
Dim celRange As Word.Range
Dim DDown As Word.ContentControl

Set tbl = doc.Tables(1) 'one table, so do it before the loop

Do While Not rst.EOF ' rst is a DAO.Recordset of shipping dates ordered chronologicly. multiple items can ship the same day
    If rst![Ship] <> currDay Then ' if nothing left to ship this day, move to next cell/row
        Exit Do
    End If

    Set cel =  tbl.Cell(i, j)
    Set celRange = cel.Range
    'Move the target focus to the end of the cell
    celRange.Collapse wdCollapseEnd
    celRange.MoveEnd wdCharacter, -1

    Set DDown = celRange.ContentControls.Add(wdContentControlDropdownList) 

    'Add items to dropdown
    DDown.DropdownListEntries.Add "Shipping within 7 days"
    DDown.DropdownListEntries.Add "On schedule"
    DDown.DropdownListEntries.Add "On Hold"

    'The target range will still be ahead of the content control, so
    'Prepare for the next content control by adding a new paragraph
    ' and putting the target area at the end of the cell
    Set celRange = cel.Range
    celRange.Collapse wdCollapseEnd
    celRange.MoveEnd wdCharacter, -1
    celRange.Text = vbCrLf  'add a new line between dropdown lists
    celRange.Collapse wdCollapseEnd

    'After some iterations, celRange remains attached to the inserted content control
    'causing an error about the target overlapping a plain text content control.
    'Selecting the range puts the focus for insertion in the right place
    celRange.Select
    Set DDown = Nothing

Loop

Answer 2

Вам необходимо переместить текущую позицию курсора выделения в точку после конца элемента управления, который вы только что добавили.Это решение, предлагаемое в вопросе SO, на который вы ссылаетесь в своем вопросе Добавление элемента управления содержимым динамически вызывает исключение

Код в этом вопросе не VBA, но базовые библиотеки такие жеОтсюда сходство.

Измените ваш цикл следующим образом:

    Do While Not rst.EOF ' rst is a DAO.Recordset of shipping dates ordered chronologicly. multiple items can ship the same day
        If rst![Ship] <> currDay Then ' if nothing left to ship this day, move to next cell/row
            Exit Do
        End If

        Set DDown = doc.Tables(1).Cell(i, j).Range.ContentControls.Add(wdContentControlDropdownList) 'This line fails upon adding a second dropdown to a cell

        ' move current selection to after the end of the newly added control
        doc.Application.Selection.Start = DDown.Range.End+1

        'Add items to dropdown
        DDown.DropdownListEntries.Add "Shipping within 7 days"
        DDown.DropdownListEntries.Add "On schedule"
        DDown.DropdownListEntries.Add "On Hold"

    Loop