Question

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

我怎样才能做到这一点？

Answer 1

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

MouseButtonRelease

Answer 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

将大表（多页表）拆分为某个单页表并将其转换为图像

2 个答案: