VBA字表复制丢失数据

我继承了一些 VBA 代码，它将 Word 文档中的表格内容复制到 Excel。该代码本身来自 Excel 插件，该插件使用后期绑定调用 Word，以避免在旧版本的 Excel 中使用时出现引用错误。该插件本身在 Office 2016 中得到维护，同时也在 Office 2016、2013 和 2010 中使用。

该计划的核心如下：

tc = 1                                                     ' table counter
For Each tbl In doc.Tables
    prev = -42                                             ' previous row

    Application.Wait DateAdd("s", 2, Now)                  ' Note this line

    For Each cel In tbl.Range.Cells
        cont = CellContents(cel.Range)                     ' dim cont() as string
        txt = cont(0)
        xx = cel.ColumnIndex
        yy = cel.RowIndex
        If yy <> prev Then
            xtra = 1                                       ' extra x cell counter
            prev = yy                                      ' reset for new row
        End If

        xtra = xtra - 1
        For Each v In cont                                 ' dim v as variant
            txt = CStr(v)
            ActiveSheet.Cells(xlrow + yy, xtra + xx).Activate
            ActiveCell = txt
            ActiveCell.Font.Bold = cel.Range.Bold
            colr = cel.Range.Font.Color
            ActiveCell.Font.Color = colr
            colr = cel.Shading.BackgroundPatternColor
            If colr <> -16777216 Then ActiveCell.Interior.Color = colr
            Select Case cel.Range.ParagraphFormat.Alignment
                Case 2 ' wdAlignParagraphRight
                    ActiveCell.HorizontalAlignment = xlRight
                Case 1 ' wdAlignParagraphCenter
                    ActiveCell.HorizontalAlignment = xlCenter
                Case 0, 3 ' wdAlignParagraphLeft, wdAlignParagraphJustify
                    ActiveCell.HorizontalAlignment = xlLeft
                Case Else
            End Select
            xtra = xtra + 1
        Next v
    Next cel
    xlrow = xlrow + tbl.rows.Count + 1
    Application.StatusBar = "Table " & tc & " in " & nm
    DoEvents
    tc = tc + 1
Next tbl

不，从 Word 复制粘贴到 Excel 不起作用，因为它不执行任何处理，不能很好地处理单元格之间的文本复制，不能很好地处理单元格中断，也不能处理内容控件。

我观察到一个问题，当此过程从 Word 复制大量大型表格时，它会丢失表格。但是，当我减慢进程时，要么通过在调试器中强制停止，要么添加Application.Wait在循环中，问题就消失了。

该代码执行以下操作：

• 对于文档，循环遍历文档中的所有表格
• 然后，对于表格，循环遍历该表格中的所有单元格并将它们复制到 Excel，保留背景和前景色

典型的文档可能有 10 到 20 个表，每个表包含 50 个或更多单元格。

几乎就像在遍历表时，如果 VBA 仍然繁忙，则后续表将返回空。

我已经尝试过以下方法：

• 使用早期绑定更改为 Word Automation
• 摆脱ActiveSheet.Cells(...).Activate事物和使用Cells(y, x) instead
• 使用计数器和 for 循环set tbl = doc.tables(tc) and set tbl = Nothing在循环结束时
• 多个DoEvents
• 只需设置单元格的文本，无需其他任何操作，循环中的工作量最少（这里我丢失的数据较少）

行为没有改变。简直就是奸诈。是的。

有没有更好的方法来做到这一点，而不需要Application.Wait or sleep？如何在开始下一次迭代之前确定 Excel 确实完成了？

请尝试一下：

Change:

For Each tbl In doc.Tables
    prev = -42

To:

For Each tbl In doc.Tables
    tbl.Select ' < add this
    prev = -42

有一个类似的问题：使用 VBA，我打开一个包含 > 300 页和 > 200 个表格的 Word 文档。当代码循环遍历文档时，它会从表中收集数据。我用的是.Select用于调试目的的行，这样我就知道代码在文档中的何处工作，但发现当我在调试后将其注释掉时，代码会运行，但不会命中每个表。

我还尝试添加一个等待循环，以确保文档在运行我的代码之前完全加载，但这没有帮助。

您还可以添加一行Application.ScreenUpdating = False靠近代码顶部以避免屏幕闪烁.Select causes.

这并不能真正回答您的问题，但也许它会让您的代码正常工作。