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

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

（）

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

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

---

我怎样才能做到这一点

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

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

---

尝试以下操作以拆分表：

    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

子拆分器（）
如果ActiveDocument.Tables.count为0，则
对于j=ActiveDocument.Tables.count到1步骤-1
设置oTbl=ActiveDocument.Tables（j）
oTbl.选择
'MsgBox提示符：=选择。信息（wdMaximumNumberOfRows），按钮：=vbOKOnly+vbInformation
如果Selection.Information（wdMaximumNumberOfRows）>30，则
'MsgBox提示符：=“如果”，按钮：=vbOKOnly+vbInformation
g=1
边做边做（g）