Excel Forum

Code: Select all

Sub PreviewWithHeaderFooter()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("ฟอร์ม")
    
    With ws.PageSetup
        ' ตั้งค่ากระดาษ A4
        .PaperSize = xlPaperA4
        .Orientation = xlPortrait
        
        ' ระยะขอบ
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(0.5)
        .LeftMargin = Application.InchesToPoints(0.3)
        .RightMargin = Application.InchesToPoints(0.3)
        
        ' แถวหัวคอลัมน์ (A9) ซ้ำทุกหน้า
        .PrintTitleRows = "$9:$9"
        .PrintTitleColumns = ""
        
        ' ปรับขนาดการพิมพ์
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        
        ' ปิด gridlines
        .PrintGridlines = False
        
        ' ใส่ข้อความหัวกระดาษจากเซลล์ A1:A7 รวมกัน
        Dim headerText As String
        Dim i As Long
        For i = 1 To 7
            headerText = headerText & ws.Cells(i, 1).Text & vbCrLf
        Next i
        
        .CenterHeader = headerText
    End With

    ' แสดงตัวอย่างก่อนพิมพ์
    ws.Range("A1:S96").PrintPreview

End Sub

Code: Select all

Sub PrintFormSheet()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("ฟอร์ม")

    Dim headerRange As Range
    Dim contentRange As Range
    Dim footerRange As Range
    Set headerRange = ws.Range("A1:S9")
    Set contentRange = ws.Range("A10:S86")
    Set footerRange = ws.Range("U10:AM19")

    Dim chartObj As ChartObject
    Set chartObj = ws.ChartObjects.Add(Left:=100, Top:=100, Width:=footerRange.Width, Height:=footerRange.Height)

    footerRange.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    chartObj.Chart.Paste

    Dim imgPath As String
    imgPath = Environ$("TEMP") & "\footer_temp.png"
    chartObj.Chart.Export Filename:=imgPath, FilterName:="PNG"
    chartObj.Delete

    With ws.PageSetup
        .PrintArea = headerRange.Address & "," & contentRange.Address
        .PaperSize = xlPaperA4
        .Orientation = xlPortrait
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)

        .PrintTitleRows = "$1:$9"
        .PrintTitleColumns = ""
        .CenterFooterPicture.Filename = imgPath
        .CenterFooter = "&G"

        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
    End With
    ws.ResetAllPageBreaks
    Dim i As Long
    For i = 40 To 86 Step 40
        ws.HPageBreaks.Add Before:=ws.Rows(i + 10)
    Next i
    ws.PrintPreview
End Sub

Code: Select all

Sub PrintFormSheet()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("¿ÍÃìÁ")

    Dim headerRange As Range
    Dim contentRange As Range
    Dim footerRange As Range
    Set headerRange = ws.Range("A1:S9")
    Set contentRange = ws.Range("A10:S86")
    Set footerRange = ws.Range("U10:AM19")

    Dim chartObj As ChartObject
    Set chartObj = ws.ChartObjects.Add(Left:=600, Top:=500, Width:=footerRange.Width - 50, Height:=footerRange.Height + 20)

    footerRange.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    chartObj.Chart.Paste

    Dim imgPath As String

    imgPath = Environ$("TEMP") & "\footer_temp.png"
    chartObj.Chart.Export Filename:=imgPath, FilterName:="PNG"
    chartObj.Delete

    With ws.PageSetup
        .PrintArea = headerRange.Address & "," & contentRange.Address
        .PaperSize = xlPaperA4
        .Orientation = xlPortrait
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)

        .PrintTitleRows = "$1:$9"
        .PrintTitleColumns = ""
        .CenterFooterPicture.Filename = imgPath
        .CenterFooter = "&G"

        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
    End With
    ws.ResetAllPageBreaks
    Dim i As Long
    For i = 10 To 86 Step 18
        ws.HPageBreaks.Add Before:=ws.Rows(i + 18)
    Next i
    ws.PrintPreview
End Sub