Tự động giãn dòng cho nhiều vùng gộp khi in ra

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!
12911290

Bạn nhập vào thì nó tự giãn, còn bấm nút nó chưa giãn nha 🙂

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

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

Sửa lại thành

For Each Cls In Range("B1:B" & Range("A650").End(xlUp).Row)
       If Range("B" & I) <> Empty Then MergeCellFit2 Cls
    Next

www.giaiphapexcel.com/diendan/threads/t%E1%BB%B1-%C4%91%E1%BB%99ng-gi%C3%A3n-d%C3%B2ng-cho-nhi%E1%BB%81u-v%C3%B9ng-g%E1%BB%99p-khi-in-ra.146182/

Khóa học SprinGO phù hợp

Ứng dụng AI và Chat GPT trong Quản trị nhân sự

Học xong khóa này, học viên có thể: Hiểu đúng bản chất AI, các nhóm AI phổ biến và cách AI “hoạt động” ở...

Xem khóa học