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

Liên hệ QC

vc_đi chơi

Thành viên hoạt động
Tham gia
21/9/19
Bài viết
159
Được thích
32
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!
qa1.pngqa2.png
 

File đính kèm

  • qa.xls
    30 KB · Đọc: 20
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
Bạn phải dùng macro hoặc chỉnh sẵn ô cho rộng rãi hết cỡ của text để in thôi. Excel nó không tự biết làm việc chỉnh như bạn muốn đâu
 
dùng macro cho từng vùng ô gộp à anh?
anh giúp em với file trên được không ạ?
cám ơn anh
 
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
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
 

File đính kèm

  • sua.xlsm
    21.2 KB · Đọc: 32
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
Sửa lại thành
Mã:
For Each Cls In Range("B1:B" & Range("A650").End(xlUp).Row)
       If Range("B" & I) <> Empty Then MergeCellFit2 Cls
    Next
 

File đính kèm

  • sua.xlsm
    21 KB · Đọc: 54
Sửa lại thành
Mã:
MergeCellFit2 Cls
Em cảm ơn!
Bài đã được tự động gộp:

Sửa lại thành
Mã:
For Each Cls In Range("B1:B" & Range("A650").End(xlUp).Row)
       If Range("B" & I) <> Empty Then MergeCellFit2 Cls
    Next
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 B3:D3, vùng B4:D4) 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.
 
Lần chỉnh sửa cuối:
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.
bình thường hết, để ô nào bao nhiêu ô gì ko ảnh hưởng gì cả.
bạn phức tạp hóa vấn đề rồi hay sao ấy.

Theo nội dung bạn đưa thì không cần macro dài dòng chi cho mệt hết.
 
bình thường hết, để ô nào bao nhiêu ô gì ko ảnh hưởng gì cả.
bạn phức tạp hóa vấn đề rồi hay sao ấy.

Theo nội dung bạn đưa thì không cần macro dài dòng chi cho mệt hết.
Vâng! cám ơn anh đã góp ý!
Bài đã được tự động gộp:

Em cảm ơn!
Bài đã được tự động gộp:


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 B3:D3, vùng B4:D4) 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.
Em cám ơn!
 
Nhờ bạn viết code giúp minh Dòng C11 với khi thay đổi nó sẽ tự dãn dòng,
Mình xin cảm ơn ĐT 0912 562268
 

File đính kèm

  • MAU.xls
    521.5 KB · Đọc: 2
Nhờ bạn viết code giúp minh Dòng C11 với khi thay đổi nó sẽ tự dãn dòng,
Mình xin cảm ơn ĐT 0912 562268
Bạn tham khảo hàm tự động giãn dòng:
 
Web KT
Back
Top Bottom