Xin được giải thích và giúp đỡ chỉnh sửa code giãn dòng tự động để có tác dụng trong sheet được chọn

Liên hệ QC

xuantocdotb

Thành viên chính thức
Tham gia
1/6/16
Bài viết
66
Được thích
23
Em chào các anh/chị trên GPE.
Em có tham khảo được code giãn dòng (Em nhớ không nhầm thì code là của thầy be09) trên diễn đàn như sau:
Mã:
Option Explicit
Sub CogianDong()
' Code nay duyet qua tat ca cac vung duoc dien trong mang cua tat ca cac sheet
Dim Dchinh As Single
Dim DRong As Range
Dim RDong As Range
Dim RCot As Double
Dim DchinhHang As Double
Dim Mang As Variant
Dim I As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'With Sheet1
With ActiveSheet
'Thay doi Cell trong Mang cho phù hop lan luot theo mau 14_, 16_, 17_, _04
Mang = Array("B5", "C5", "C9", "C10", "B13", "C14", , "C7", "C9", , "D8", "D9", "D10", "D11", "D12", , "B8", "B11", "B12", "B13")

    For I = 0 To UBound(Mang)
        On Error Resume Next
        Set RDong = Range(Range(Mang(I)).MergeArea.Address)
        RDong.MergeCells = False
        RCot = RDong.Cells(1).ColumnWidth
        Dchinh = 0
            For Each DRong In RDong
                DRong.WrapText = True
                Dchinh = DRong.ColumnWidth + Dchinh
            Next
        Dchinh = Dchinh + RDong.Cells.Count * 0.6
        RDong.Cells(1).ColumnWidth = Dchinh
        RDong.EntireRow.AutoFit
        DchinhHang = RDong.RowHeight
        RDong.Cells(1).ColumnWidth = RCot
        RDong.MergeCells = True
        RDong.RowHeight = DchinhHang
    Next I
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End With
End Sub
Xin nhờ các anh/chị giúp em mấy vấn đề sau:
1.>Thay vì duyệt qua tất cả các vùng "Mang = Array("B5", "C5", "C9", "C10", "B13", "C14", , "C7", "C9", , "D8", "D9", "D10", "D11", "D12", , "B8", "B11", "B12", "B13")" có trong tất cả các Sheet thì chỉnh phần nào để nó có tác dụng với vùng cần giãn dòng trong từng sheet một, nếu coppy code này vào từng sheet một thì sẽ được nhưng như vậy nhiều sheet có dẫn đến code chạy chậm không ạ?
2.> Có thế chỉnh phần nào trong đoạn code để: khoảng cách giữa các chữ, và khoảng cách từ viền bao đến chữ (nhiều khi em nhìn trên excel thì chữ không bị mất nét nhưng khi in ra thì chữ sát viền bo quá hoặc nhiều khi nội dung chữ bị che khuất bởi viền).
Xin nhờ các anh, chị giúp em!
Em xin cảm ơn!
 
Lần chỉnh sửa cuối:
Em chào các anh/chị trên GPE.
Em có tham khảo được code giãn dòng (Em nhớ không nhầm thì code là của thầy be09) trên diễn đàn như sau:
Mã:
Option Explicit
Sub CogianDong()
' Code nay duyet qua tat ca cac vung duoc dien trong mang cua tat ca cac sheet
Dim Dchinh As Single
Dim DRong As Range
Dim RDong As Range
Dim RCot As Double
Dim DchinhHang As Double
Dim Mang As Variant
Dim I As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'With Sheet1
With ActiveSheet
'Thay doi Cell trong Mang cho phù hop lan luot theo mau 14_, 16_, 17_, _04
Mang = Array("B5", "C5", "C9", "C10", "B13", "C14", , "C7", "C9", , "D8", "D9", "D10", "D11", "D12", , "B8", "B11", "B12", "B13")

    For I = 0 To UBound(Mang)
        On Error Resume Next
        Set RDong = Range(Range(Mang(I)).MergeArea.Address)
        RDong.MergeCells = False
        RCot = RDong.Cells(1).ColumnWidth
        Dchinh = 0
            For Each DRong In RDong
                DRong.WrapText = True
                Dchinh = DRong.ColumnWidth + Dchinh
            Next
        Dchinh = Dchinh + RDong.Cells.Count * 0.6
        RDong.Cells(1).ColumnWidth = Dchinh
        RDong.EntireRow.AutoFit
        DchinhHang = RDong.RowHeight
        RDong.Cells(1).ColumnWidth = RCot
        RDong.MergeCells = True
        RDong.RowHeight = DchinhHang
    Next I
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End With
End Sub
Xin nhờ các anh/chị giúp em mấy vấn đề sau:
1.>Thay vì duyệt qua tất cả các vùng "Mang = Array("B5", "C5", "C9", "C10", "B13", "C14", , "C7", "C9", , "D8", "D9", "D10", "D11", "D12", , "B8", "B11", "B12", "B13")" có trong tất cả các Sheet thì chỉnh phần nào để nó có tác dụng với vùng cần giãn dòng trong từng sheet một, nếu coppy code này vào từng sheet một thì sẽ được nhưng như vậy nhiều sheet có dẫn đến code chạy chậm không ạ?
2.> Có thế chỉnh phần nào trong đoạn code để: khoảng cách giữa các chữ, và khoảng cách từ viền bao đến chữ (nhiều khi em nhìn trên excel thì chữ không bị mất nét nhưng khi in ra thì chữ sát viền bo quá hoặc nhiều khi nội dung chữ bị che khuất bởi viền).
Xin nhờ các anh, chị giúp em!
Em xin cảm ơn!
Ai giúp con mới ạ! con đang thật sự rất cần>
 
Web KT
Back
Top Bottom