Giúp code Wrap text ô trộn (Merge cells)

[hanhpptc]

Đối với ô không trộn, khi thực hiện căn chỉnh độ cao tự động của dòng thì ta chọn Wrap text là được. Tuy nhiên, với ô có dữ liệu là ô trộn (Merge cells), thì không tự động căn chỉnh độ cao của dòng được, cho dù đã đã thực hiện chọn Wrap text. Xin các bạn hướng dẫn Code tự động căn chỉnh giúp mình với.

 

[Quang_Hải]

Cám ơn quanghai1969! Tuy cách của bạn mượn cột phụ D để set chiều cao của dòng nhưng chạy được. Trước mắt mình áp dụng chiêu này đã trước khi có thuật toán hay hơn. Một lần nữa cám ow3n bạn.

Theo gợi ý của anh PTM mình thử code thế này, bạn xem coi thế nào. Mình code cho font chữ 12, nếu bạn sử dụng font size khác thì sửa lại số 0.13 cho phù hợp

Sub wrap()
Application.ScreenUpdating = False
Dim dl, i, n, size
Set dl = [a1:a20]
n = [a:a].ColumnWidth + [b:b].ColumnWidth + [c:c].ColumnWidth
  For i = 1 To dl.Rows.Count
    size = dl(i, 1).Font.size
    dl(i, 1).WrapText = True
    dl(i, 1).RowHeight = Len(dl(i, 1)) / Round(n) * size * 0.13 * size
  Next
Application.ScreenUpdating = True
End Sub

 

[ndu96081631]

Theo gợi ý của anh PTM mình thử code thế này, bạn xem coi thế nào. Mình code cho font chữ 12, nếu bạn sử dụng font size khác thì sửa lại số 0.13 cho phù hợp

Sub wrap()
Application.ScreenUpdating = False
Dim dl, i, n, size
Set dl = [a1:a20]
n = [a:a].ColumnWidth + [b:b].ColumnWidth + [c:c].ColumnWidth
  For i = 1 To dl.Rows.Count
    size = dl(i, 1).Font.size
    dl(i, 1).WrapText = True
    dl(i, 1).RowHeight = Len(dl(i, 1)) / Round(n) * size * 0.13 * size
  Next
Application.ScreenUpdating = True
End Sub

Vì AutoFit không có tác dụng với Merge Cell nên giải thuật sẽ thế này
- Đầu tiên tính chiều rộng của Merge Cell (tạm gọi là curWidth)
- Xong, hủy Merge Cell để dữ liệu nằm trong 1 cell duy nhất
- Chỉnh chiều rộng của cell chứa dữ liệu đúng bằng với curWidth
- AutoFit cell này đồng thời lấy chiều cao mới (tạm gọi là lastHeight)
- Cuối cùng, Merge Cell trở lại và chỉnh chiều rộng = curWidth, chiều cao = lastHeight
- Set Wrap Text cho cell vừa Merge
------------------
Đại khái thế! Làm thử xem

 

[luckyboss]

Mình làm được bằng VBA rồi, cách làm giống tương tự của pro ndu96081631
-Copy dữ liệu ra ô tạm khác (chọn ô ko liên quan, VD cell(1000,1000))
-Gán columwidth ô Merge gán vào ô tạm, wraptext ô tạm, sau đó lấy rowheight ô tạm. Gán rowheight ô tạm vào ô Merge rồi xóa cột tạm đó (để không ảnh hưởng khi in) là xong.
-Nhớ chỉnh Cell Style giống như font hiện hành sẽ không bị lỗi.
File bên dưới mình làm được rồi. Thanks!

 

[queluatb]

File bên dưới mình làm được rồi. Thanks!

Mình làm được bằng VBA rồi, cách làm giống tương tự của pro ndu96081631
-Copy dữ liệu ra ô tạm khác (chọn ô ko liên quan, VD cell(1000,1000))
-Gán columwidth ô Merge gán vào ô tạm, wraptext ô tạm, sau đó lấy rowheight ô tạm. Gán rowheight ô tạm vào ô Merge rồi xóa cột tạm đó (để không ảnh hưởng khi in) là xong.
-Nhớ chỉnh Cell Style giống như font hiện hành sẽ không bị lỗi.
File bên dưới mình làm được rồi. Thanks!

Anh/chị vui lòng giải thích giúp em khi em gán thêm vùng dữ liệu, tại RangeData = Range("A8", "G8") khi tính độ rộng gán sang Range("L2") đúng với số cột trong vùng, nhưng với độ rộng của cả vùng thì RangeData tại vị trí này đúng ra không cần wraptext nhưng khi gán trở lại RangeData thì bị lỗi do Range("L2") Wraptext, em có gửi lại flie anh chị vui lòng xem giúp em vì như thế tại vị trí của RangeData = Range("A8", "G8") nhìn sẽ rất xấu, mặc dù dữ liệu thực tế có thể hên xui đúng theo dữ liệu giả định
Em xin cám ơn