将大表（多页表）拆分为一些单页表并将其转换为图像答案

【问题标题】：Split Big tables (Multiple page table) to some single page table and convert it to image将大表（多页表）拆分为一些单页表并将其转换为图像
【发布时间】：2016-06-28 19:19:59
【问题描述】：

我使用此宏将表格转换为 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

(Reference of macro)

它的工作很好，但我的问题是当表格很大时（多页表格）转换的图像质量非常低，因为宏将所有表格转换为单页图像。

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

我怎样才能做到这一点？

【问题讨论】：

标签： vba ms-word ms-office

【解决方案1】：

只需检查最大数量。要使用宏剪切的行数：宏来检查行数并仅选择它们：

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

【讨论】：

【解决方案2】：

试试这个拆分表：

    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

【讨论】：