VBA字表复制丢失数据

Question

我继承了一些 VBA 代码，它将 Word 文档中的表格内容复制到 Excel。该代码本身来自 Excel 插件，该插件使用后期绑定(bind)调用 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 仍然繁忙，则后续表将返回空。

我尝试过以下方法:

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

行为没有改变。简直就是奸诈。 ужас。

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

Answer 1

请尝试一下:

更改:

For Each tbl In doc.Tables
    prev = -42

致:

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

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

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

您还可以在代码顶部附近添加一行 Application.ScreenUpdating = False 以避免导致屏幕闪烁 .Select。

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