ตรวจสอบ CodeVB สั่งPrint

[tigerwit]

สวัสดีครับ
ผมกำลังทำโปรแกรมเลื่อนเงินเดือนแบบ % ไว้ใช้ในโรงเรียน
มีปัญหาที่จะมาขอคำแนะนำดังนี้ครับ

1.ในชีท Page3 ตามตัวอย่าง มีข้อมูลครูอยูู่ 35 แถว จากที่ได้สร้างแถวไว้เผื่อจำนวนครู ถึง 190 แถว
2. ต้องการสั่งพิมพ์ ชีท Page3 ออกมา หน้าละ 16 แถว จะเป็น 3 หน้า และหน้าที่ 3 ให้นำแถวสุดท้าย ที่ Sum ยอดรวม เงินเดือนมาต่อท้ายไว้
3. ถ้ามีข้อมูลครูเพียง 5 แถว (ดังตัวอย่างในชีท Page4) ก็ให้สั่งพิมพ์ออกมา 16 แถว โดยมีข้อมูลครู 5 แถว ที่เหลือแถวที่ 6-16 ก็ว่างไว้ และให้นำ ยอด Sum มาต่อท้ายไว้

Code: Select all

Option Explicit
Sub BeforePrint()
Dim r As Range
Dim i As Integer
Application.ScreenUpdating = False
Set r = Worksheets("Page3").Range("A214")
    Do While r.Offset(i, 0) = ""
    r.Offset(i, 0).EntireRow.Hidden = True
    i = i - 1
    Loop
Worksheets("Page3").PrintOut
Worksheets("Page3").Range("A:A").EntireRow.Hidden = False
Application.ScreenUpdating = True
End Sub

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub BeforePrint()
    Dim r As Range, t As Range
    Dim i As Integer, s As Integer
    Dim j As Integer
    
    Application.ScreenUpdating = False
    Set t = Worksheets("page3").Range("a7")
    Set r = Worksheets("Page3").Range("A214")
    
    If t.Value = "" Then Exit Sub
    For j = 0 To 215 Step 19
        If t.Offset(j, 0).Value = "" Then Exit For
    Next j
    Worksheets("page3").Range(t.Offset(j, 0), r).EntireRow.Hidden = True
'        Do While r.Offset(i, 0) = ""
'            r.Offset(i, 0).EntireRow.Hidden = True
'            i = i - 1
'        Loop
    Worksheets("Page3").PrintOut
    Worksheets("Page3").Range("A:A").EntireRow.Hidden = False
    Application.ScreenUpdating = True
End Sub

[tigerwit]

ขอบคุณครับผม

[tigerwit]

สวัสดีครับได้ทดสอบกับข้อมูลจริง จำนวน 133 คน ได้ตามต้องการ ตัดที่ 7 หน้า
ข้อมูล 20 ตัดที่ 2 หน้า พร้อมทั้งนำยอดสรุปมาต่อท้าย
แต่พอข้อมูลครู 5 คน กลบไม่เป็นไปตามที่ต้องการครับ ที่ต้องการคือตัดให้เป็นหน้าเดียว พร้อมนำยอดสรุปมาต่อท้าย
แต่สิ่งที่ได้คือเป็น 2 หน้า ยอดสรุปอยู่หน้าที่ 2 ตามไฟล์ PDF ที่แนบมาครับ

[tigerwit]

ไฟล์ที่ทดสอบครับ

[snasui]

ผมเพิ่ม Sheet1 มาให้เพื่อใช้สำหรับการ Print โดยเฉพาะด้วย Code ตามด้านล่างครับ

นำ Code นี้ไป Update Code ในไฟล์แนบใหม่ เนื่องจากในไฟล์แนบยังไม่ Update ครับ

Code: Select all

Sub test0()
    Dim r As Range, i As Integer
 
    For i = 0 To 255 Step 20
        
        With Worksheets("page3")
            If .Range("a7").Offset(i, 0).Value <> "" Then
                .Range("a7").Offset(i, 0).Resize(20, 25).Copy _
                    Worksheets("Sheet1").Range("a7")
            Else
                Exit Sub
            End If
        End With

        With Worksheets("Sheet1")
            If .Range("a26").Value = "" Then
                .PageSetup.PrintArea = .Range("a1:y27").Address
            Else
                .PageSetup.PrintArea = .Range("a1:y27").Address
            End If
            With .PageSetup
                .FitToPagesWide = 1
                .FitToPagesTall = 1
            End With
            Worksheets("Sheet1").PrintOut
        End With
    Next i
End Sub

[tigerwit]

ขอบคุณครับ
ได้อย่างที่ต้องการเรื่องการจัดหน้าแล้วครับ
แต่ติดนิดเดียวตรงบรรทัดสุดท้ายที่เอาข้อมูล Sum ยอดเงินรวมมาใส่ทุกหน้า
ซึ่งที่ต้องการคือถ้ามีหลายหน้าก็ให้สรุปใส่ในหน้าสุดท้ายเท่านั้น

[snasui]

ผมลืมแก้ไปนิดนึงครับ

ตัวอย่างการปรับ Code ครับ

Code: Select all

'Other code
            If .Range("a26").Value = "" Then
                .PageSetup.PrintArea = .Range("a1:y27").Address
            Else
                .PageSetup.PrintArea = .Range("a1:y26").Address
            End If
'Other code

[tigerwit]

สวัสดีครับ
มารายงานผลการใช้งานครับ
จาก Code ที่ได้รับคำแนะนำพบว่า
กรณีที่มีจำนวนครู ตั้งแต่ 1-19 คน ได้ตามความต้องการ มีการสรุปยอดท้ายรายงานให้ ตัดในหน้าเดียว
กรณีมีจำนวนครูมากว่า 20 คน ขึ้นไป ก็ได้ตามความต้องการ มีการตัดรายชื่อไปขึ้นหน้าที่ 2 ในคนที่ 21
แต่ปัญหาที่พบคือ ถ้ามีครู 20 คนพอดี จะตัดที่หน้า 1 แต่ไม่มีสรุปยอดท้ายรายงานให้ครับ

[snasui]

ได้ปรับ Code มาแล้วหรือไม่ ปรับเป็นแบบไหน กรุณาแนบไฟล์พร้อม Code มาด้วยจะได้ตอบต่อไปจากนั้นครับ

[tigerwit]

ไฟล์แนบครับ

Code: Select all

Sub test0()
    Dim r As Range, i As Integer
     For i = 0 To 215 Step 20
                With Worksheets("page3")
            If .Range("a7").Offset(i, 0).Value <> "" Then
                .Range("a7").Offset(i, 0).Resize(20, 26).Copy _
                    Worksheets("Sheet1").Range("a7")
            Else
                Exit Sub
            End If
        End With
        With Worksheets("Sheet1")
            If .Range("a26").Value = "" Then
                .PageSetup.PrintArea = .Range("a1:y27").Address
            Else
                .PageSetup.PrintArea = .Range("a1:y26").Address
            End If
            With .PageSetup
                .FitToPagesWide = 1
                .FitToPagesTall = 1
            End With
            Worksheets("Sheet1").PrintOut
        End With
    Next i
End Sub

[snasui]

อันนั้นคือ Code เดิมที่ยังไม่ได้ปรับ ช่วยปรับมาก่อนครับ

[tigerwit]

อ้าว!!ผมงงเอง
ได้แล้วครับ
ขอบคุณครับผม

Code: Select all

Sub test0()
    Dim r As Range, i As Integer
 
    For i = 0 To 255 Step 20
        
        With Worksheets("page3")
            If .Range("a7").Offset(i, 0).Value <> "" Then
                .Range("a7").Offset(i, 0).Resize(20, 25).Copy _
                    Worksheets("Sheet1").Range("a7")
                
            If .Range("a26").Value = "" Then
                .PageSetup.PrintArea = .Range("a1:y27").Address
            Else
                .PageSetup.PrintArea = .Range("a1:y26").Address
            End If
                    
            Else
                Exit Sub
            End If
        End With

        With Worksheets("Sheet1")
            If .Range("a26").Value = "" Then
                .PageSetup.PrintArea = .Range("a1:y27").Address
            Else
                .PageSetup.PrintArea = .Range("a1:y27").Address
            End If
            With .PageSetup
                .FitToPagesWide = 1
                .FitToPagesTall = 1
            End With
            Worksheets("Sheet1").PrintOut
        End With
    Next i
End Sub

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub test0()
    Dim r As Range, i As Integer
    Dim j As Integer, k As Integer
 
    With Worksheets("page3")
        j = .Range("a7", .Range("a" & .Rows.Count).End(xlUp)).Rows.Count
    End With
    k = 0
    For i = 0 To 215 Step 20
        
        With Worksheets("page3")
            If .Range("a7").Offset(i, 0).Value <> "" Then
                .Range("a7").Offset(i, 0).Resize(20, 26).Copy _
                    Worksheets("Sheet1").Range("a7")
            Else
                Exit Sub
            End If
        End With

        With Worksheets("Sheet1")
            k = k + .Range("a7", .Range("a" & .Rows.Count).End(xlUp)).Rows.Count
            If .Range("a26").Value = "" Or k = j Then
                .PageSetup.PrintArea = .Range("a1:y27").Address
            Else
                .PageSetup.PrintArea = .Range("a1:y26").Address
            End If
            With .PageSetup
                .FitToPagesWide = 1
                .FitToPagesTall = 1
            End With
            Worksheets("Sheet1").PrintOut
        End With
    Next i
End Sub