Làm sao căn chỉnh bảng trong Word vừa vặn 1 trang = VBA ? (1 người xem)

[phanminhphuong]

Mình có thử đoạn code để căn chỉnh bảng ()như file đính kèm vừa vặn 1 trang để in nhưng chưa biết sai chỗ nào nên chưa đạt yêu cầu
[GPECODE=vb]Sub Fit_Table_To_1_Page()

'Application.ScreenUpdating = False
Dim TopMargin As Long, BottomMargin As Long
Dim PageHeight As Long, lngHeight As Long
Dim Table1, i As Long, RowsHeight
Set Table1 = ThisDocument.Tables(1)

' Xa'c dinh kich co cua trang
With ThisDocument.PageSetup
TopMargin = .TopMargin
BottomMargin = .BottomMargin
PageHeight = .PageHeight
End With

' Xac dinh do cao vung in
lngHeight = PageHeight - TopMargin - BottomMargin
' Tinh tong chieu cao cac dong tru dong cuoi cung
For i = 1 To Table1.Rows.Count - 1
RowsHeight = RowsHeight + Table1.Rows(i).Height
Next i

' Thiet lap chieu cao dong cuoi cung
Table1.Rows(Table1.Rows.Count).Height = lngHeight - RowsHeight

'Application.ScreenUpdating = True
End Sub[/GPECODE]

-Nếu làm thủ công thì dùng chuột đưa đến dòng kẻ ngang cuối cùng và kéo đến sát đáy trang (không bị nhảy sang trang thứ 2)
tức là mình làm giãn rows(13) nếu bảng ngắn & co rows(13) nếu bảng dài sao cho cả bảng vừa khít 1 page
(Nói thêm: bao giờ cũng căn được vào 1 trang vì dữ liệu không nhiều & rows(13) còn thừa rất nhiều)

Tuy nhiên code chạy lại không được.
Xin trợ giúp mình để mình có thể ứng dụng cho nhiều file khác ạ.

 

[huuthang_bd]

Mình có thử đoạn code để căn chỉnh bảng ()như file đính kèm vừa vặn 1 trang để in nhưng chưa biết sai chỗ nào nên chưa đạt yêu cầu
[GPECODE=vb]Sub Fit_Table_To_1_Page()

'Application.ScreenUpdating = False
Dim TopMargin As Long, BottomMargin As Long
Dim PageHeight As Long, lngHeight As Long
Dim Table1, i As Long, RowsHeight
Set Table1 = ThisDocument.Tables(1)

' Xa'c dinh kich co cua trang
With ThisDocument.PageSetup
TopMargin = .TopMargin
BottomMargin = .BottomMargin
PageHeight = .PageHeight
End With

' Xac dinh do cao vung in
lngHeight = PageHeight - TopMargin - BottomMargin
' Tinh tong chieu cao cac dong tru dong cuoi cung
For i = 1 To Table1.Rows.Count - 1
RowsHeight = RowsHeight + Table1.Rows(i).Height
Next i

' Thiet lap chieu cao dong cuoi cung
Table1.Rows(Table1.Rows.Count).Height = lngHeight - RowsHeight

'Application.ScreenUpdating = True
End Sub[/GPECODE]

-Nếu làm thủ công thì dùng chuột đưa đến dòng kẻ ngang cuối cùng và kéo đến sát đáy trang (không bị nhảy sang trang thứ 2)
tức là mình làm giãn rows(13) nếu bảng ngắn & co rows(13) nếu bảng dài sao cho cả bảng vừa khít 1 page
(Nói thêm: bao giờ cũng căn được vào 1 trang vì dữ liệu không nhiều & rows(13) còn thừa rất nhiều)

Tuy nhiên code chạy lại không được.
Xin trợ giúp mình để mình có thể ứng dụng cho nhiều file khác ạ.

Thuật toán của bạn còn sai nhiều chỗ:
1. Cái tiêu đề ở ngoài bảng nên không thể lấy chiều cao trang giấy trừ chiều cao từ dòng 1 đến dòng gần cuối để xác định chiều cao dòng cuối được. Cách này chỉ đúng khi bảng ở đầu trang.
2. Rows(i).Height không phải là chiều cao mà bạn nhìn thấy, cái bạn thấy có thể sẽ lớn hơn. Nôm na là Rows(i).Height là chiều cao tối thiểu của dòng. Ví dụ Rows(2).Height là 50, khi dòng 2 có 1 dòng hay 10 dòng thì Rows(2).Height vẫn là 50, nhưng khi dòng 2 có 10 dòng thì chiều cao của dòng 2 sẽ tự dãn ra để có thể chứa hết 10 dòng nhưng Rows(2).Height vẫn là 50.

Vì điểm thứ 2 nên code của bạn hoàn toàn bị phá sản và bạn không thể làm được theo hướng này.

 

[phanminhphuong]

Thuật toán của bạn còn sai nhiều chỗ:
1. Cái tiêu đề ở ngoài bảng nên không thể lấy chiều cao trang giấy trừ chiều cao từ dòng 1 đến dòng gần cuối để xác định chiều cao dòng cuối được. Cách này chỉ đúng khi bảng ở đầu trang.
2. Rows(i).Height không phải là chiều cao mà bạn nhìn thấy, cái bạn thấy có thể sẽ lớn hơn. Nôm na là Rows(i).Height là chiều cao tối thiểu của dòng. Ví dụ Rows(2).Height là 50, khi dòng 2 có 1 dòng hay 10 dòng thì Rows(2).Height vẫn là 50, nhưng khi dòng 2 có 10 dòng thì chiều cao của dòng 2 sẽ tự dãn ra để có thể chứa hết 10 dòng nhưng Rows(2).Height vẫn là 50.

Vì điểm thứ 2 nên code của bạn hoàn toàn bị phá sản và bạn không thể làm được theo hướng này.

Cảm ơn bạn. Loay hoay mãi vẫn chưa có hướng nào giải quyết chứ làm 500 file = thủ công chắc chết quá. Hic hic
Các bạn trợ giúp mình với...

 

[huuthang_bd]

Thử làm vầy xem

Sub Fit_Table_To_1_Page()
Application.ScreenUpdating = False
Dim EndRow
Set EndRow = ThisDocument.Tables(1).Rows(ThisDocument.Tables(1).Rows.Count)
EndRow.Range.Select
Selection.EndOf Unit:=wdCell
While ThisDocument.ComputeStatistics(wdStatisticPages) = 1
    Selection.TypeParagraph
Wend
While ThisDocument.ComputeStatistics(wdStatisticPages) = 2
    Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
    If Trim(Selection.Range.Text) = "" Then Selection.TypeBackspace Else GoTo Lb
Wend
Lb:
Application.ScreenUpdating = True
End Sub

 

[phanminhphuong]

Thử làm vầy xem

Sub Fit_Table_To_1_Page()
Application.ScreenUpdating = False
Dim EndRow
Set EndRow = ThisDocument.Tables(1).Rows(ThisDocument.Tables(1).Rows.Count)
EndRow.Range.Select
Selection.EndOf Unit:=wdCell
While ThisDocument.ComputeStatistics(wdStatisticPages) = 1
    Selection.TypeParagraph
Wend
While ThisDocument.ComputeStatistics(wdStatisticPages) = 2
    Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
    If Trim(Selection.Range.Text) = "" Then Selection.TypeBackspace Else GoTo Lb
Wend
Lb:
Application.ScreenUpdating = True
End Sub

Tks bạn. Code đã giải quyết được yêu cầu.
(chỉ mỗi không thích Selection.TypeParagraph) Mình sẽ cố gắng tìm hiểu thêm xem có cách nào căn được như mình kéo viền dưới = chuột không.

 

[huuthang_bd]

Tks bạn. Code đã giải quyết được yêu cầu.
(chỉ mỗi không thích Selection.TypeParagraph) Mình sẽ cố gắng tìm hiểu thêm xem có cách nào căn được như mình kéo viền dưới = chuột không.

Nếu bạn vẫn muốn "kéo" thì đây:

Sub Fit_Table_To_1_Page()
Application.ScreenUpdating = False
Dim EndRow
Set EndRow = ThisDocument.Tables(1).Rows(ThisDocument.Tables(1).Rows.Count)
EndRow.Height = 1
If ThisDocument.ComputeStatistics(wdStatisticPages) = 1 Then
    While ThisDocument.ComputeStatistics(wdStatisticPages) = 1
        EndRow.Height = EndRow.Height + 50
    Wend
    While ThisDocument.ComputeStatistics(wdStatisticPages) = 2
        EndRow.Height = EndRow.Height - 5
    Wend
End If
Application.ScreenUpdating = True
End Sub

 

[phanminhphuong]

Nếu bạn vẫn muốn "kéo" thì đây:

Sub Fit_Table_To_1_Page()
Application.ScreenUpdating = False
Dim EndRow
Set EndRow = ThisDocument.Tables(1).Rows(ThisDocument.Tables(1).Rows.Count)
EndRow.Height = 1
If ThisDocument.ComputeStatistics(wdStatisticPages) = 1 Then
    While ThisDocument.ComputeStatistics(wdStatisticPages) = 1
        EndRow.Height = EndRow.Height + 50
    Wend
    While ThisDocument.ComputeStatistics(wdStatisticPages) = 2
        EndRow.Height = EndRow.Height - 5
    Wend
End If
Application.ScreenUpdating = True
End Sub

Chuẩn luôn. Nếu tiện vui lòng diễn giải giúp mình để học hỏi them. Tks.

 

[huuthang_bd]

Chuẩn luôn. Nếu tiện vui lòng diễn giải giúp mình để học hỏi them. Tks.

Thuật toán như sau:
- Tăng chiều cao dòng cuối bảng thêm 50 cho đến khi thành 2 trang
- Giảm chiều cao dòng cuối bảng bớt 5 cho đến khi còn 1 trang