Canh trang vừa đúng một trang bằng VBA

[hong loi]

Em xin chào các Thầy ! Em xin các Thầy giúp em canh trang tự động vừa đúng 1 trang A4 bằng VBA (do thêm dữ liệu vào cột hoặc dòng kế tiếp làm tràn trang in ).

Em đã test bằng 2 cách đều cho kết quả không đạt yêu cầu. Em test như sau:

Trước hết em cho tự động Set Print_Area vùng cần in, sau đó em record macro

Cách 1:
Vào Page Setup --> chọn Fit to --> chọn Ok --> được code này:

 With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = "$A$1:$F$66"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "mot trang"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
    End With

Khi cho test lại code, code này chạy đúng nhưng rất nặng nề, chậm chạp ,em không biết phải xử lý ra sao để code chạy nhanh.

Cách 2:

Vào PrintPreview --> Print Break Preview --> kéo vạch kẻ đứt đoạn màu xanh( có 2 vạch đứng và ngang chính là 2 vạch ngắt cột và ngắt dòng) đến đường biên màu xanh liền nét (cũng chính là mép phải và mép dưới của vùng Print_Area) ,em được code này

ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
    ActiveSheet.HPageBreaks(1).DragOff Direction:=xlDown, RegionIndex:=1

Khi cho chạy lại code --> hiện thông báo lổi này

Vậy phải sửa code sao cho: Nếu vạch đứt quảng( vạch ngắt cột và ngắt dòng) nằm trong phạm vi vùng Print_Area thì 2 dòng code này chạy.Đây chỉ là suy nghỉ của em còn thực tế phải làm thế nào em không biết nũa.

Rất mong các Thầy trợ giúp em cám ơn vô cùng.

 

[huuthang_bd]

Macro chi cho mệt. Sao bạn không chỉnh vầy

 

[vanle33]

Macro chi cho mệt. Sao bạn không chỉnh vầy

Dùng những kỹ thuật cơ bản để ra hiệu quả cao tuyệt đối, bạn huuthangbd và bạn hong loi nhỉ?
ps: Ngoài luồng tý, tôi thấy đội tuyển bóng đá VN mà có kỹ thuật cơ bản thì đã thắng trên nhiều chiến trường, chưa có kỹ thuật cơ bản đã lo biểu diễn, thua là phải. Đây là quan điểm cá nhân mà tôi nhận thấy. Cho dù tôi hầu như chưa bao giờ xem bóng đá VN, chỉ liếc qua vài phút là đủ thấy.

 

[hong loi]

Em cám ơn 2 Thầy chỉ dạy. Nếu chỉ có một sheet ,cách hướng dẫn trên là quá hay quá đũ, nhưng file em sử dụng có đến 20 sheet thường xuyên thêm bớt dòng cột ,nếu không dùng chức năng tự động --> lúc in nguyên file lỡ quên canh lại một trang thôi sẽ phải bõ hết in lại từ đầu, thế đấy các Thầy ạ. Đúng là kiến thức của em quá nông cạn mày mò mãi vẫn không làm được. Một lần nữa xin các Thầy thông cảm giúp cho em ạ.

 

[Vô danh Tiểu tốt]

Nếu đề cập tới VBa sao bạn không thử

Sub Macro1()
'
' Macro1 Macro
'
'
'    Application.PrintCommunication = False
'    With ActiveSheet.PageSetup
'        .PrintTitleRows = ""
'        .PrintTitleColumns = ""
'    End With
'    Application.PrintCommunication = True
'    ActiveSheet.PageSetup.PrintArea = ""
'    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
'        .LeftHeader = ""
'        .CenterHeader = ""
'        .RightHeader = ""
'        .LeftFooter = ""
'        .CenterFooter = ""
'        .RightFooter = ""
'        .LeftMargin = Application.InchesToPoints(0.7)
'        .RightMargin = Application.InchesToPoints(0.7)
'        .TopMargin = Application.InchesToPoints(0.75)
'        .BottomMargin = Application.InchesToPoints(0.75)
'        .HeaderMargin = Application.InchesToPoints(0.3)
'        .FooterMargin = Application.InchesToPoints(0.3)
'        .PrintHeadings = False
'        .PrintGridlines = False
'        .PrintComments = xlPrintNoComments
'        .CenterHorizontally = False
'        .CenterVertically = False
'        .Orientation = xlPortrait
'        .Draft = False
'        .PaperSize = xlPaperA4
'        .FirstPageNumber = xlAutomatic
'        .Order = xlDownThenOver
'        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
'        .PrintErrors = xlPrintErrorsDisplayed
'        .OddAndEvenPagesHeaderFooter = False
'        .DifferentFirstPageHeaderFooter = False
'        .ScaleWithDocHeaderFooter = True
'        .AlignMarginsHeaderFooter = True
'        .EvenPage.LeftHeader.Text = ""
'        .EvenPage.CenterHeader.Text = ""
'        .EvenPage.RightHeader.Text = ""
'        .EvenPage.LeftFooter.Text = ""
'        .EvenPage.CenterFooter.Text = ""
'        .EvenPage.RightFooter.Text = ""
'        .FirstPage.LeftHeader.Text = ""
'        .FirstPage.CenterHeader.Text = ""
'        .FirstPage.RightHeader.Text = ""
'        .FirstPage.LeftFooter.Text = ""
'        .FirstPage.CenterFooter.Text = ""
'        .FirstPage.RightFooter.Text = ""
    End With
'    Application.PrintCommunication = True
End Sub

 

[hong loi]

Cám ơn anh Vô danh Tiểu tốt thật nhiều, em làm theo hướng dẫn của anh giờ nó không còn chậm nữa. Em cảm nhận anh là người ngược với nickname của anh.