Xin được nhờ các anh chị giúp em:
Dữ liệu được lấy từ sheet"Du lieu" sang sheet "Chi tiet" theo số thứ tự
Khi in dữ liệu trong sheet"Chi tiet" tương ứng với số thứ tự trong sheet"Du lieu" em in từ 1 cho đến 2
Cho em hỏi có cách nào để khi in, chiều cao của các ô trong sheet"Chi tiết" được lấy dữ liệu sang sẽ tự động giãn dòng để
bao vừa nội dung dữ liệu được lấy từ sheet "Du lieu" sang.
Em xin cảm ơn!
Xin được nhờ các anh chị giúp em:
Dữ liệu được lấy từ sheet"Du lieu" sang sheet "Chi tiet" theo số thứ tự
Khi in dữ liệu trong sheet"Chi tiet" tương ứng với số thứ tự trong sheet"Du lieu" em in từ 1 cho đến 2
Cho em hỏi có cách nào để khi in, chiều cao của các ô trong sheet"Chi tiết" được lấy dữ liệu sang sẽ tự động giãn dòng để
bao vừa nội dung dữ liệu được lấy từ sheet "Du lieu" sang.
Em xin cảm ơn! View attachment 228098View attachment 228099
Nếu để trên một dòng mà nhiều vùng gộp như vậy, chắc thực hiện giãn dòng tự động khó.
Em gộp tất cả các ô vào trên một hàng trong vùng cần điền nội dung làm một.
Em có tham khảo đoạn code để giãn dòng vùng cần gộp trên một dòng trong vùng cần in
Nhưng bị lỗi, anh xem sửa lại giúp em để có thể áp dụng vào bài này, file em đã gộp các ô trên cùng một dòng
Mã:
Sub AutoFit()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Dim Cls As Range
For Each Cls In Range("a1:a" & Range("A650").End(xlUp).Row)
MergeCellFit Cls
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub MergeCellFit2(ByVal MergeCells As Range)
Dim Diff As Single
Dim FirstCell As Range, MergeCellArea As Range
Dim col As Long, ColCount As Long, RowCount As Long
Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double
If MergeCells.Count = 1 Then
Set MergeCellArea = MergeCells.MergeArea
Else
Set MergeCellArea = MergeCells
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
With MergeCellArea
ColCount = .Columns.Count
RowCount = .Rows.Count
.WrapText = True
If RowCount = 1 And ColCount = 1 Then
.EntireRow.AutoFit
GoTo ExitSub
End If
Set FirstCell = .Cells(1, 1)
FirstCellWidth = FirstCell.ColumnWidth
Diff = 0.75
For col = 1 To ColCount
MergeCellWidth = MergeCellWidth + .Cells(1, col).ColumnWidth + Diff
Next
.MergeCells = False
FirstCell.ColumnWidth = MergeCellWidth - Diff
.EntireRow.AutoFit
FirstCellHeight = FirstCell.RowHeight
.MergeCells = True
FirstCell.ColumnWidth = FirstCellWidth
FirstCellHeight = FirstCellHeight / RowCount
.RowHeight = FirstCellHeight
End With
ExitSub:
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Nếu để trên một dòng mà nhiều vùng gộp như vậy, chắc thực hiện giãn dòng tự động khó.
Em gộp tất cả các ô vào trên một hàng trong vùng cần điền nội dung làm một.
Em có tham khảo đoạn code để giãn dòng vùng cần gộp trên một dòng trong vùng cần in
Nhưng bị lỗi, anh xem sửa lại giúp em để có thể áp dụng vào bài này, file em đã gộp các ô trên cùng một dòng
Mã:
Sub AutoFit()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Dim Cls As Range
For Each Cls In Range("a1:a" & Range("B650").End(xlUp).Row)
MergeCellFit Cls
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub MergeCellFit2(ByVal MergeCells As Range)
Dim Diff As Single
Dim FirstCell As Range, MergeCellArea As Range
Dim col As Long, ColCount As Long, RowCount As Long
Dim FirstCellWidth As Double, FirstCellHeight As Double, MergeCellWidth As Double
If MergeCells.Count = 1 Then
Set MergeCellArea = MergeCells.MergeArea
Else
Set MergeCellArea = MergeCells
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
With MergeCellArea
ColCount = .Columns.Count
RowCount = .Rows.Count
.WrapText = True
If RowCount = 1 And ColCount = 1 Then
.EntireRow.AutoFit
GoTo ExitSub
End If
Set FirstCell = .Cells(1, 1)
FirstCellWidth = FirstCell.ColumnWidth
Diff = 0.75
For col = 1 To ColCount
MergeCellWidth = MergeCellWidth + .Cells(1, col).ColumnWidth + Diff
Next
.MergeCells = False
FirstCell.ColumnWidth = MergeCellWidth - Diff
.EntireRow.AutoFit
FirstCellHeight = FirstCell.RowHeight
.MergeCells = True
FirstCell.ColumnWidth = FirstCellWidth
FirstCellHeight = FirstCellHeight / RowCount
.RowHeight = FirstCellHeight
End With
ExitSub:
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Anh/chị cho em hỏi thêm chút:
Có cách nào in dữ liệu như bài 6 em đính kèm, để sheet "Chi tiet" in ra theo số thứ tự của sheet"Du lieu"mà các vùng được gộp (vùng B33, vùng B44) trong cùng một dòng của sheet"Chi tiet" tự động giãn dòng vừa với nội dung tương ứng với mỗi số thứ tự của"Du lieu"
được lấy sang.
Nếu để trên một dòng mà nhiều vùng gộp như vậy, chắc thực hiện giãn dòng tự động khó.
Em gộp tất cả các ô vào trên một hàng trong vùng cần điền nội dung làm một.
Anh/chị cho em hỏi thêm chút:
Có cách nào in dữ liệu như bài 6 em đính kèm, để sheet "Chi tiet" in ra theo số thứ tự của sheet"Du lieu"mà các vùng được gộp (vùng B33, vùng B44) trong cùng một dòng của sheet"Chi tiet" tự động giãn dòng vừa với nội dung tương ứng với mỗi số thứ tự của"Du lieu"
được lấy sang.
***** CẬP NHẬT - v2.42 ***** Cập nhật 2.42 sửa một số lỗi trong mã và tăng tốc giãn dòng bằng cách giãn đồng thời các ô giá trị cùng cột Và thêm các hàm bổ trợ giãn dòng cho Bảng để tiết kiệm hơn trong quá trình giãn dòng, với hàm bổ trợ fit_Tables() Dự kiến bản cập nhật tiếp theo Thêm hàm...
