[Nhờ] Chỉnh sửa code giãn dòng và in ấn

[quyent]

Em chào các anh chị, em có 1 file chứa code dãn dòng và in ấn. Khi không in thì click mũi tên thì giãn rất vừa. Nhưng lúc view lên thì có biên bản giãn đều, biên bản giãn rất rộng. Những dòng em bôi vàng. Mong mọi người chỉnh sửa giúp

 

[PacificPR]

Em chào các anh chị, em có 1 file chứa code dãn dòng và in ấn. Khi không in thì click mũi tên thì giãn rất vừa. Nhưng lúc view lên thì có biên bản giãn đều, biên bản giãn rất rộng. Những dòng em bôi vàng. Mong mọi người chỉnh sửa giúp

Nhìn thấy Code FixRow này hình như gặp ở đâu rồi í
Mà mình thấy nó bình thường mà
Bạn sửa lại Code ChayBB như thế này cho nó nhanh hơn 1 chút:

Sub ChayBB()
    Application.ScreenUpdating = False
    FixRow Range("B16:Z16")
    FixRow Range("B33:Z33")
    Range("B88").RowHeight = Range("B16").RowHeight
    Range("B117").RowHeight = Range("B16").RowHeight
    Range("B141").RowHeight = Range("B33").RowHeight
    Application.ScreenUpdating = True
End Sub

 

[quyent]

Nhìn thấy Code FixRow này hình như gặp ở đâu rồi í
Mà mình thấy nó bình thường mà
Bạn sửa lại Code ChayBB như thế này cho nó nhanh hơn 1 chút:

Sub ChayBB()
    Application.ScreenUpdating = False
    FixRow Range("B16:Z16")
    FixRow Range("B33:Z33")
    Range("B88").RowHeight = Range("B16").RowHeight
    Range("B117").RowHeight = Range("B16").RowHeight
    Range("B141").RowHeight = Range("B33").RowHeight
    Application.ScreenUpdating = True
End Sub

Hi, chào bạn. Đây là code bạn làm giúp mình. Còn đây là hình ảnh khi 1 cái view in. 1 cái chỉ click mũi tên

 

[PacificPR]

Hi, chào bạn. Đây là code bạn làm giúp mình. Còn đây là hình ảnh khi 1 cái view in. 1 cái chỉ click mũi tên

Mình thấy bình thường. Bạn kiểm tra thiết lập máy in đã đúng khổ giấy chưa
Bổ sung cho bạn code tách tiêu chuẩn nghiệm thu ra từng dòng in cho đẹp

 

[quyent]

Mình thấy bình thường. Bạn kiểm tra thiết lập máy in đã đúng khổ giấy chưa
Bổ sung cho bạn code tách tiêu chuẩn nghiệm thu ra từng dòng in cho đẹp

Mình vẫn không sao làm được bạn ạ. Đã xem lại thiết lập của máy in rồi. Bạn có thể bớt chút thời gian teamvie cho mình được không

 

[vc_đi chơi]

Nhìn thấy Code FixRow này hình như gặp ở đâu rồi í
Mà mình thấy nó bình thường mà
Bạn sửa lại Code ChayBB như thế này cho nó nhanh hơn 1 chút:

Sub ChayBB()
    Application.ScreenUpdating = False
    FixRow Range("B16:Z16")
    FixRow Range("B33:Z33")
    Range("B88").RowHeight = Range("B16").RowHeight
    Range("B117").RowHeight = Range("B16").RowHeight
    Range("B141").RowHeight = Range("B33").RowHeight
    Application.ScreenUpdating = True
End Sub

Option Explicit
Sub FixRow(ByVal rng As Range)
    Dim Ws As Worksheet
    Dim I As Long, cell As Range, MrgeWdth As Single, Ma As Range
    Dim WithCellPaste As Long, ColPaste As Long, RowPaste As Long, CellPaste As Range, Diff As Single
    On Error Resume Next
    Diff = 0.75
    Set Ws = rng.Worksheet
    ColPaste = Ws.Columns.Count
    For I = 1 To rng.Count
        If rng(I) <> Empty Then
            Set Ma = rng(I).MergeArea
            For Each cell In Ma
                MrgeWdth = MrgeWdth + cell.ColumnWidth + Diff
            Next cell
            Ma.RowHeight = 16.5
            RowPaste = Ma.row
            Set CellPaste = Cells(RowPaste, ColPaste)
            WithCellPaste = CellPaste.ColumnWidth
            CellPaste.ColumnWidth = MrgeWdth
            CellPaste = Ma.Value
            rng(I, 1).Copy
            CellPaste.PasteSpecial xlPasteFormats
            CellPaste.WrapText = True
            CellPaste.EntireRow.AutoFit
            Ma.RowHeight = CellPaste.RowHeight + 16.5 / 5
            CellPaste.Clear
            CellPaste.ColumnWidth = WithCellPaste
        End If
    Next I
End Sub

Sub ChayBB()
    Application.ScreenUpdating = False
    FixRow Range("B16:Z16")
    FixRow Range("B33:Z33")
    Range("B88").RowHeight = Range("B16").RowHeight
    Range("B117").RowHeight = Range("B16").RowHeight
    Range("B141").RowHeight = Range("B33").RowHeight
    Application.ScreenUpdating = True
End Sub

Chào bạn, mình có tham khảo 2 đoạn code trên.
Bạn cho mình hỏi mấy nội dung sau mới nhé!
Sub FixRow có tác dụng gì vậy bạn?
Sub ChayBB() mình thấy khi chạy code này thì tự động sẽ giãn dòng vùng gộp trong sheet
Sub FixRow và Sub ChayBB() luôn đi kèm với nhau đúng không bạn?
Sub ChayBB() nếu muốn áp dụng cho 1 sheet bất kỳ thì làm thế nào vậy?
Mình có nhiều sheet và trong các sheet có nhiều vùng gộp cần được giãn dòng, thì cần phải chỉnh sửa đoạn code này như thế nào bạn?

 

[dangky47h]

Nhìn thấy Code FixRow này hình như gặp ở đâu rồi í
Mà mình thấy nó bình thường mà
Bạn sửa lại Code ChayBB như thế này cho nó nhanh hơn 1 chút:

Sub ChayBB()
    Application.ScreenUpdating = False
    FixRow Range("B16:Z16")
    FixRow Range("B33:Z33")
    Range("B88").RowHeight = Range("B16").RowHeight
    Range("B117").RowHeight = Range("B16").RowHeight
    Range("B141").RowHeight = Range("B33").RowHeight
    Application.ScreenUpdating = True
End Sub

Chào chị PacificPR
Chị cho em hỏi:
1/.Em muốn để tự động giãn dòng từ dòng 16 đến 21 thì chỉnh code như thế nào ạ? (như hình tải kèm)
2/.Dòng code " Range("B88").RowHeight = Range("B16").RowHeight" có nghĩa như thế nào vậy ạ?
Em cảm ơn chị!

 

[Gà Công Nghệ]

Mình thấy bình thường. Bạn kiểm tra thiết lập máy in đã đúng khổ giấy chưa
Bổ sung cho bạn code tách tiêu chuẩn nghiệm thu ra từng dòng in cho đẹp

hi, lâu quá mới thấy bạn.

 

[dangky47h]

hi, lâu quá mới thấy bạn.

bạn khỏe chứ! hỳ

 

[Gà Công Nghệ]

bạn khỏe chứ! hỳ

Mình vẫn khỏe
dangky47h , mà mình đang nói bạn @PacificPR .