拆分大表（多页表）一些单页表和使用该宏将其转换为图像

林为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个图像表格）。

我该如何做到这一点？

来源

2015-08-09 y.feizi

尝试这种拆分表：

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

来源

2016-06-28 08:02:09

只需检查最大编号。行要切断与您的宏：宏检查的行数，并选择只是其中：

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

来源

2015-08-09 09:05:46 Balinti

拆分大表（多页表）一些单页表和使用该宏将其转换为图像

回答

相关问题