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

Liên hệ QC
P

phanminhphuong

Thành viên hoạt động
Tham gia
26/7/13
Bài viết
127
Được thích
68
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 ạ.
 

File đính kèm

  • WORD VBA - HOW TO FIT TABLE TO ONE PAGE.doc
    46 KB · Đọc: 49
Lần chỉnh sửa cuối:
phanminhphuong đã viết:
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 ạ.
Nhấp chuột vào đây để mở rộng...

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.
 
huuthang_bd đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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...
 
Thử làm vầy xem
PHP: 
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
 
huuthang_bd đã viết:
Thử làm vầy xem
PHP: 
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
Nhấp chuột vào đây để mở rộng...
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.
 
phanminhphuong đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Nếu bạn vẫn muốn "kéo" thì đây:
PHP: 
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
 
huuthang_bd đã viết:
Nếu bạn vẫn muốn "kéo" thì đây:
PHP: 
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
Nhấp chuột vào đây để mở rộng...
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.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

B
  • Question
Chuyển đổi dữ liệu sạng dạng mảng
Trả lời
5
Đọc
79
ongke0711
ongke0711
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
Trả lời
11
Đọc
155
ho van luong
H
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
6
Đọc
136
Hoàng Tuấn 868
H
S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
Trả lời
0
Đọc
59
shnhatha221108
S
T
Không hiện dữ liệu ở ô công thức
Trả lời
3
Đọc
72
thien-16
T
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom