CODEWITHSUNDEEP
vbams-wordms-office
YFeizi
YFeizi

Reputation: 1528

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

Im using this macro for converting tables to image in word document: 

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 )

Its work great but my problem is when table is big (multiple page table) converted image has very low quality because the macro convert all the table to a single page image.

Now i want to change this macro when it reach to end of page split the table and convert only this part and then continue converting to end of table. the result will be an image for every page of table (e.g 5 image for 5 page table).

How can i achieve this?

Upvotes: 1

Views: 321

Answers (2)

amini gazar
amini gazar

Reputation: 91

try this to split 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

Upvotes: 1

Balinti
Balinti

Reputation: 1534

Just check the max no. of rows you want to cut with your macro: macro to check the number of rows and select only them:

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

Upvotes: 2

Related Questions