แสดงข้อมูลหน้า Forms ตามเงื่อนไข

[wisitsakbenz]

เรียน อาจารย์

ป้อนข้อมูลใน Q1-Q5 หรืออาจจะไม่ป้อนทั้งหมด แล้วคลิกปุ่ม Preview หลังจากนั้นข้อมูลจะถูกใส่ใน Sheet "Forms"
1. ต้องการให้ในแต่ละ Question มีเว้นบรรทัดประมาณ 20 บรรทัด แล้วค่อยขึ้น Question ใหม่
2. Default ในหน้า Forms มีแค่หน้าเดียว หากใน 1 หน้าไม่พอ ให้แสดงหัวข้อใหม่ในหน้าใหม่
3. จัดรูปแบบเส้นขอบตามหน้าแรก (ตาม Sheet ที่ต้องการ)
ต้องปรับ Code อย่างไรครับ ขอบคุณครับ

Code: Select all

Sub Preview()

'Define abbreviations for worksheets
    Dim WI As Worksheet
    Dim WF As Worksheet
    Set WI = Worksheets("Input")
    Set WF = Worksheets("Forms")
       
    
'Detailed Question
    Dim AmountCell1 As Range
    Dim HeadingRow1 As Integer
    Dim CurrentRow1 As Integer
         
    HeadingRow1 = WF.Range("FormsFirstLine1").Row
    CurrentRow1 = HeadingRow1
    
    For Each AmountCell1 In WI.Range("Question").Cells
        If AmountCell1 <> "" Then
            WF.Cells(HeadingRow1, 6) = ""
            CurrentRow1 = CurrentRow1 + 1
            WF.Cells(CurrentRow1, 2) = AmountCell1.Text
            CurrentRow1 = CurrentRow1 + 20

        End If
    Next    
End Sub

[snasui]

ที่เขียนเอาไว้แล้วมีปัญหาอะไรครับ

สำหรับการทำงานตามที่อธิบายมา เพื่อให้ง่ายควรสร้าง Template ที่มีการจัดรูปแบบเอาไว้เรียบร้อยแล้วเพื่อพร้อมใช้งาน จากนั้นจะ Loop Question ไปวางใน Template แล้ว Copy Template ไปวางยังบรรทัดล่างของข้อมูลก่อนหน้า จะได้ไม่ต้องทำไปจัด Format ไป

สำหรับการแสดงผลเมื่อ Preview จะต้องไปจัดการเรื่อง Print Area และการจัด Layout โดยให้ Set Print Area ถึงข้อมูลในหน้าสุดท้าย หากต้องการให้แสดงผลและ Print ให้พอดีหน้า จะต้องมีการกำหนดความสูงข้อมูลให้เท่ากับจำนวนรายการ สิ่งที่ควรทราบเพิ่มเติมคือ Page Setup อยู่ภายใต้เมนู Page Layout และ Scale to Fit อยู่ภายใต้เมนู Page Layout เช่นกัน

สำหรับ Scale to Fit ให้กำหนด Width เป็น 1 และ กำหนด Height ให้มีจำนวนหน้าเท่ารายการ Question ที่มี

[wisitsakbenz]

เรียน อาจารย์ snasui

ผมลองปรับ Code แต่ยังติด Error อยู่
รบกวนอาจารย์ช่วยปรับ Code ให้หน่อยครับ ขอบคุณครับ

Code: Select all

Sub Preview()

'Define abbreviations for worksheets
    Dim WI As Worksheet
    Dim WF As Worksheet
    Set WI = Worksheets("Input")
    Set ws4 = Worksheets("Forms")
    
ws4.Range("A12").Resize(1000, 1).EntireRow.Delete
ws4.Range("B11:AC1000").ClearContents
          
      'Sheet input
 
                With Sheets("input")
                    Set rDataAll = .Range("B2:B5", .Range("B" & Rows.Count).End(xlUp))
                End With
            i = 12
            For Each r In rDataAll
        If r = rFind Then
            ws4.Range("b" & i).Resize(1, 2).Value = _
                r.Offset(0, 1).Resize(1, 2).Value
                ws4.Range("d" & i).Resize(1, 2).Font.Name = "Arial Unicode MS"
                ws4.Range("d" & i).Resize(1, 2).Font.Size = 12
            
            i = i + 1
        End If
    Next r
    
        With ws4.Range(ws4.Cells(CurrentRow1 - 20, 2), ws4.Cells(CurrentRow1 - 1, 1)).Borders(xlEdgeLeft)
               .LineStyle = xlContinuous
               .ColorIndex = 0
                .TintAndShade = 0
               .Weight = xlMedium
            End With
           
       With ws4.Range(ws4.Cells(CurrentRow1 - 20, 2), ws4.Cells(CurrentRow1 - 1, 30)).Borders(xlEdgeRight)
               .LineStyle = xlContinuous
               .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlMedium
            End With

    
End Sub