将大 tables（多页 table）拆分为一些单页 table 并将其转换为图像

Question

我正在使用此宏将 tables 转换为 word 文档中的图像：

Dim tbl As Table

For i = ActiveDocument.Tables.Count To 1 Step -1
    Set tbl = ActiveDocument.Tables(i)
    tbl.Select
    Selection.Cut
    Selection.PasteSpecial Link:=False, dataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
Next i

( )

效果很好，但我的问题是当 table 很大（多页 table）时，转换后的图像质量非常低，因为宏将所有 table 转换为单页图片。

现在我想在它到达页面末尾时更改此宏拆分 table 并仅转换这部分然后继续转换到 table 的末尾。结果将是 table 每页的图像（例如 5 页 table 的 5 张图像）。

我怎样才能做到这一点？

Answer 1

只需检查最大数量。您要使用宏剪切的行数：检查行数的宏，select 只有它们：

If Selection.Information(wdMaximumNumberOfRows) > 30 Then
   Selection.Rows(1).Select
   Selection.MoveDown Unit:=wdParagraph, Count:=30, Extend:=wdExtend
   End If

Answer 2

试试这个拆分 table:

    Sub Spliter()
If ActiveDocument.Tables.count <> 0 Then
    For j = ActiveDocument.Tables.count To 1 Step -1
        Set oTbl = ActiveDocument.Tables(j)
            oTbl.Select
            'MsgBox Prompt:=Selection.Information(wdMaximumNumberOfRows), Buttons:=vbOKOnly + vbInformation
            If Selection.Information(wdMaximumNumberOfRows) > 30 Then
            'MsgBox Prompt:="if", Buttons:=vbOKOnly + vbInformation
                    g = 1
                    Do While (g <= Selection.Information(wdMaximumNumberOfRows))
                        'MsgBox Prompt:=g, Buttons:=vbOKOnly + vbInformation
                        If Selection.Information(wdMaximumNumberOfRows) < 30 Then Exit Do
                            Selection.Rows(g).Select
                            Selection.MoveDown Unit:=wdParagraph, count:=30, Extend:=wdExtend
                            Selection.Cut
                            Selection.Rows(1).Select
                            Selection.HomeKey Unit:=wdLine
                            Selection.MoveUp Unit:=wdLine, count:=1
                            Selection.EndKey Unit:=wdLine
                            Selection.TypeParagraph
                            Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
                                Placement:=xlMoveAndSize, DisplayAsIcon:=False
                            oTbl.Select
                            'MsgBox Prompt:=Selection.Information(wdMaximumNumberOfRows), Buttons:=vbOKOnly + vbInformation
                    Loop
                    If Selection.Information(wdMaximumNumberOfRows) < 30 Then
                        Selection.Cut
                        Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
                            Placement:=xlMoveAndSize, DisplayAsIcon:=False
                    End If
            Else
                Selection.Cut
                Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=xlMoveAndSize, DisplayAsIcon:=False
            End If
    Next j
    '    Call Log("#ActiveDocument.Tables>Image = True ", False)
End If
End Sub

将大 tables（多页 table）拆分为一些单页 table 并将其转换为图像

Split Big tables (Multiple page table) to some single page table and convert it to image

vba

ms-word

ms-office