Code VBA เมื่อถึงบรรทัดที่กำหนดให้แสดง PrintPreview ค่ะ

[suka]

เรียนอาจารย์และท่านผู้รู้ช่วยปรับ Code ค่ะ

ที่ไฟล์ wbShare ชีท Report มีการใสข้อมูลจาก A2:H2 มาเรื่อยๆและเมื่อถึง A35:H35 ต้องการให้ชีท Report แสดง PrintPreview ค่ะ
Code ที่ใช้อยู่ตามนี้ค่ะ

Code: Select all

With formBook.Sheets("TemBilling")
    .Range("P10:W10").Resize(.Range("Y9")).Copy
    End With
    wbShare.Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    formBook.Sheets("Form").Range("G4:G10,H1,I4:N10,M12").ClearContents
    With formBook.Sheets("Form")
        .Range("N2") = .Range("N2") + 1
    End With

Code ได้จากการบันทึก Macro ตามนี้ค่ะ

Code: Select all

Sub Macro1()
  Range("A16:H16").Select
  Application.CutCopyMode = False
  Selection.Copy
  Sheets("Sheet2").Select
  Range("A35").Select
   Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
   xlNone, SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
  ActiveWindow.SelectedSheets.PrintPreview
End Sub

ขอบคุณค่ะ

[snasui]

ที่เขียนมานั้นผิดพลาดหรือแสดงผลอย่างไร ผลลัพธ์ที่ต้องการนั้นต้องการให้แสดงผลอย่างไรครับ

[suka]

อาจารย์คะ ต้องการใช้ช่วยแนะปรับเพื่อนำใช้เข้ากับ Code ชุดด้านล่างนี้ค่ะ
ความต้องการให้แสดง PrintPreview เมื่อมีการใส่ข้อมูลที่เซลล์ A35:H35 ที่ไฟล์ wbShare ชีท Report การใส่ข้อมูลจาก A2:H34 ให้ใส่ไปเรื่อยๆ พื้นที่กำหนด PrintArea A1:H35"ค่ะ

Code: Select all

Sub BeenArL()
    Dim wbShare As Workbook
    Dim wb As Workbook ' declare wb as workbook
    Dim wdShare As Workbook
    Dim formBook As Workbook
    Dim wdShareOpen As Boolean
    Dim rSource As Range
    Dim rTarget As Range
    Dim rs As Range
    Dim rt As Range
    Dim i As Double
    Set formBook = ThisWorkbook
    Set wbShare = Workbooks("ArBookShare.xlsx")
    For Each wb In Workbooks ' loop wb not loop wdShare
        If wb.Name = "PoWbShare.xlsx" Then
            wdShareOpen = True
        End If
    Next wb
    If Not wdShareOpen Then
        ChDir "\\Server\DATA (E)\My P S  Project.xls\PS.BookShare\AR.ระบบลูกหนี้"
    Workbooks.Open Filename:="\\Server\DATA (E)\My P S  Project.xls\PS.BookShare\AR.ระบบลูกหนี้\PoWbShare.xlsx"
    End If
    Set wdShare = Workbooks("PoWbShare.xlsx") 'set wdShare after open not before open
    With formBook.Sheets("Form")
        Set rSource = .Range("B3:B50")
    End With
    With wdShare.Sheets("Sheet1")
        Set rTarget = .Range("E2", .Range("E" & Rows.Count).End(xlUp))
    End With
    With formBook.Sheets("Form")
        i = (.Range("L11") + .Range("M11") + .Range("M12"))
        If i <> .Range("J12") Then
            MsgBox "โปรดตรวจจำนวนเงินและบันทึกใหม่"
            Exit Sub
        End If
    End With
    Application.Calculation = xlCalculationManual
    For Each rs In rSource
        For Each rt In rTarget
            If rt = rs Then rt.Offset(0, 25) = "Y"
        Next rt
    Next rs
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
    Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    With formBook.Sheets("TemBilling")
    .Range("a2:p2").Resize(.Range("q1")).Copy
    End With
    wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    With formBook.Sheets("TemBilling")
    .Range("P10:W10").Resize(.Range("Y9")).Copy
    End With
    wbShare.Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    formBook.Sheets("Form").Range("G4:G10,H1,I4:N10,M12").ClearContents
    With formBook.Sheets("Form")
        .Range("N2") = .Range("N2") + 1
    End With
    Application.ScreenUpdating = True
    Windows("PoWbShare.xlsx").Activate
    ActiveWorkbook.Save
    Windows("ArBookShare.xlsx").Activate
    ActiveWorkbook.Save
    Windows("AR.Form.xlsm").Activate
    ActiveWorkbook.Save
    End Sub

[snasui]

ต้องปรับมาเองครับ แล้วบอกมาว่าที่ปรับมาแล้วนั้นแสดงผลผิดพลาดอย่างไร ต้องการคำตอบเป็นอย่างไร

การยก Code มาควรจะยกมาเฉพาะที่เกียวข้องกับงานที่ทำ ณ ปัจจุบันที่ติดปัญหา ไม่ใช่ยกมาทั้งหมดครับ

[suka]

อาจารย์คะ Code ปรับตามนี้ ติดตามรูปแนบค่ะ ขอบคุณค่ะ

Code: Select all

With formBook.Sheets("TemBilling")
    .Range("P10:W10").Resize(.Range("Y9")).Select
  Application.CutCopyMode = False
  Selection.Copy
   wbShare.Sheets("Report").Select
  Range("A35").Select
   Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
   xlNone, SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
  ActiveWindow.SelectedSheets.PrintPreview
    End With

[nattasiray]

การเข้าถึง Range ในเวิร์คชีตของเวิร์คบุคอื่น ต้องใช้ Application.Goto ครับ

Code: Select all

Application.Goto Workboooks(1).Worksheets(1).Range("G44")

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

With formBook.Sheets("TemBilling")
    .Range("P10:W10").Resize(.Range("Y9")).Copy
    wbShare.Sheets("Report").Range("A35").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.PrintPreview
End With

[suka]

ความต้องการให้แสดง PrintPreview เมื่อข้อมูลใส่ถึงที่เซลล์ A35:H35 ที่ชีท Report ไฟล์ ArBookShare ที่ VBA Set เป็น wbShare = Workbooks("ArBookShare.xlsx") ค่ะ
เมื่อปรับ Code ตามด้านล่างนี้ PrintPreview ไปที่ชืท Form กรอกข้อมูลค่ะ และขึ้นแถบสีเหลืองตามรูปแนบค่ะ

Code: Select all

 With formBook.Sheets("TemBilling")
    .Range("P10:W10").Resize(.Range("Y9")).Copy
    wbShare.Sheets("Report").Range("A35").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.PrintPreview
    End With
    wbShare.Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    formBook.Sheets("Form").Range("G4:G10,H1,I4:N10,M12").ClearContents
    With formBook.Sheets("Form")
        .Range("N2") = .Range("N2") + 1
    End With

[snasui]

บรรทัดนั้นเป็นการ Paste ซึ่งก่อนหน้าที่จะ Paste ต้อง Copy มาก่อน จาก Code ที่เขียนมาไม่พบว่ามีการ Copy มาก่อนที่จะ Paste ครับ

หาก Copy แล้วต้องการ Paste ซ้ำ ๆ หลาย ๆ ตำแหน่ง จะต้องไม่เขียน Code ยกเลิกการ Copy คือ Application.CutCopyMode = False เข้ามาแทรก เมื่อยกเลิกการ Copy ไปก็เป็นปกติที่จะวางไม่ได้ หากเขียน Code การวางก็จะเกิด Error ครับ

[suka]

อาจารย์คะขอรบกวนช่วยปรับ Code ด้านล่างนี้หน่อยค่ะ
ยังติดอยู่ที่ยังแก้ไม่ได้ค่ะที่ชีท Report เมื่อวางข้อมูลถึงเซลล์ A35 ต้องการให้แสดง PrintPreview ที่ชีท Report
แต่ Code ด้านล่างนี้พอวางข้อมูลถึงเซลล์ A35 กลับแสดง PrintPreview ที่ชีท Form กรอกข้อมูลค่ะ

Code: Select all

 With formBook.Sheets("TemBilling")
    .Range("P10:W10").Resize(.Range("Y9")).Copy
    wbShare.Sheets("Report").Range("A35").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False
    ActiveWindow.SelectedSheets.PrintPreview
    End With

[snasui]

ต้องการให้แสดง PrintPreview ที่ชีท Report

การให้แสดง Print Preview ที่ไฟล์ไหน ชีทไหน เซลล์ไหนก็ต้องบอกโปรแกรมครับ จาก code นี้ ActiveWindow.SelectedSheets.PrintPreview เป็นการแสดง Print Preview ในชีทที่เลือก หากต้องการจะ Print Preview ในชีท Report ให้ลองเขียนเป็น Sheets("Report").Range("a1:c100").PrintPreview โดย a1:c100 คือช่วงที่ต้องการ

[suka]

อาจารย์คะ Code ด้านล่างนี้ ต้องการให้ใส่ข้อมูลที่ชีท Report จากเซลล์ A2 ที่ว่างก็ใส่ข้อมูลลงมาเรื่อยไม่ต้อง pop up PrintPreview จนเมื่อถึง A35 ให้ pop up PrintPreview จากช่วงเซลล์ A1:A35 ค่ะ แต่ Code นี้ติดตรงวางข้อมูลต่อจากเซลล์ A2 ที่ว่างและวางที่ A35 และ pop up PrintPreview ทุกครั้งค่ะ รบกวนช่วยด้วยค่ะ

Code: Select all

With formBook.Sheets("TemBilling")
   .Range("P10:W10").Resize(.Range("Y9")).Copy
   wbShare.Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
       .Offset(1, 0).PasteSpecial xlPasteValues
    wbShare.Sheets("Report").Range("A35").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
   xlNone, SkipBlanks:=False, Transpose:=False
   wbShare.Sheets("Report").Range("a1:h35").PrintPreview
    End With

[snasui]

การทำเช่นนั้นก็ต้องเขียน Code ไปตรวจสอบครับว่ามีค่าใน A35 แล้วหรือไม่ หากมีแล้วค่อย Pop-up หากไม่มีก็ยังไม่ต้อง Pop-up ลองเขียนมาดูก่อน ติดตรงไหนค่อยมาดูกันต่อครับ

[suka]

อาจารย์คะ Code ด้านล่างนี้ได้ตามต้องการแล้ว แต่ยังติดตรงพอ Preview ชีท Report แล้วไม่สามารถกด Logo Microsoft เพื่อเข้า Print ได้ค่ะ

Code: Select all

With formBook.Sheets("TemBilling")
    .Range("P10:W10").Resize(.Range("Y9")).Copy
    wbShare.Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
     .Offset(1, 0).PasteSpecial xlPasteValues
         If wbShare.Sheets("Report").Range("A35") <> "" Then
    wbShare.Sheets("Report").Range("a1:h35").PrintPreview
    End If
   End With

[snasui]

กดไม่ได้ก็ถือว่าเป็นปกติที่จะเป็นเช่นนั้นเพราะในหน้าต่าง Print Preview ควรจะมีปุ่ม Print มาให้เรียบร้อยแล้ว จึงไม่จำเป็นต้องไปหาปุ่ม Print จากที่อื่น หากจะทำเช่นนั้นต้องปิดหน้าต่าง Print Preview ออกไปก่อนครับ

[suka]

อาจารย์คะ เมื่อเข้าหน้าต่าง Print Preview แล้วไม่สามารถกดปุ่มใดๆได้เลยค่ะ ปุ่ม Print ก็เข้าไม่ได้ค่ะ

[snasui]

ในเครื่องผมเมื่อเรียก Print Preview ด้วย Code แล้วสามารถทำงานได้ตามปกติครับ

[suka]

อาจารย์คะ ลองแก้เปลี่ยนให้ Activate ชีท Report แทนด้วย Code ด้านล่างนี้ไม่ได้ผลค่ะ

Code: Select all

With formBook.Sheets("TemBilling")
    .Range("P10:W10").Resize(.Range("Y9")).Copy
    wbShare.Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
     .Offset(1, 0).PasteSpecial xlPasteValues
         If wbShare.Sheets("Report").Range("A35") <> "" Then
    Windows("ArBookShare.xlsx").Activate
    End If
   End With

เป็นเพราะช่วงท้ายของ Code นี้หรือไม่คะ ที่ค้านกับ Code ด้านบนค่ะ

Code: Select all

formBook.Sheets("Form").Range("G4:G10,H1,I4:N10,M12").ClearContents
    With formBook.Sheets("Form")
        .Range("N2") = .Range("N2") + 1
    End With
    Application.ScreenUpdating = True
    Windows("PoWbShare.xlsx").Activate
    ActiveWorkbook.Save
    Windows("ArBookShare.xlsx").Activate
    ActiveWorkbook.Save
    Windows("AR.FormBySu").Activate
    ActiveWorkbook.Save
    End Sub

[snasui]

ไม่เข้าใจครับ ไม่ทราบว่าปัญหาคืออะไร ต้องการคำตอบเป็นอย่างไรครับ ปัญหาก่อนหน้านี้สามารถแก้ไขได้แล้วยังครับ

[suka]

ปัญหาก่อนหน้านี้สามารถแก้ไขได้แล้วยังครับ

แก้ไม่ได้ค่ะ ไม่สามารถคลิ๊กปุ่มใดได้เลยค่ะ นอกจากกดที่แป้นคีย์บอร์ด Esc ออกจาก Print Preview เท่านั้นค่ะ

ไม่ทราบว่าปัญหาคืออะไร ต้องการคำตอบเป็นอย่างไรครับ

เลยทดลองแก้ปัญหาด้วยการเปลี่ยนให้ Activate ชีท Report แทนเมื่อวางข้อมูลถึงเซลล์ A35 ค่ะ ต้องการให้โปรแกรมเตือนให้ Print รายงานค่ะ