Question

我正在访问数据库中创建一个函数，该函数使用其中包含预制表的模板创建日历。在特定日期进行的每次装运都会有一个“状态”下拉列表。我能够为表中的每个单元格创建一个下拉列表，但是一旦我将set语句移入此do-while循环内，就会立即得到以下消息：

某些控件无法添加到该位置

其次：

运行时错误'4198'：命令失败

正在访问

我发现了这个问题，提到了内容控件的问题： Adding content control throws an exception dynamically

但是它不在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

我原本希望每天会产生多个下拉列表，但在第一行的第二个单元格中会导致一个下拉列表（周日无法发货，因此它跳过了每一行的第一个单元格）无法添加内容控件

Answer 1

将事物放入表中的棘手部分是确保目标位置在单元格中，而不在表结构中，或者在内容控件的情况下，在内容控件中。使用Range对象可以使此操作更容易控制。

请注意，当i和j递增时，问题代码中尚不清楚，因此可能需要针对实际循环进行调整。由于我没有您的数据库，因此我的测试是在上下文之外完成的，但是类似这样，将其构建到问题代码中。

首先，声明用于处理目标表，单元格和范围的对象。关键是在插入新内容之前折叠目标Range。

在循环中插入大量内容控件时，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

您需要将当前选择光标的位置移至刚添加的控件结束后的位置。这是您在问题Adding content control throws an exception dynamically

中引用的SO问题中提供的解决方案

该问题中的代码不是VBA，但是底层库是相同的，因此很相似。

如下更改循环：

Util.setBC(frame)

向表中的单元格添加多个下拉列表时，“无法将某些控件添加到该位置”

2 个答案: