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

[suka]

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

โค้ด: เลือกทั้งหมด
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 ลองปรับเพื่อต้องการให้ไฟล์ ArBookShare.xlsx ชีท Report Pop-up เมื่อวางข้อมูล A35 แต่โปรแกรมไม่ Pop-up ค่ะ

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

โค้ด: เลือกทั้งหมด
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

เลยไม่แน่ใจว่าจะเป็นเพราะ Code บรรทัดนี้หรือไม่ค่ะเพราะไฟล์ AR.FormBySu จะขึ้นบังไฟล์ไฟล์ ArBookShare.xlsx อยู่ค่ะ

Code: Select all

Windows("AR.FormBySu").Activate

รบกวนอาจรย์ช่วยดูให้หน่อยค่ะ

[snasui]

ก็ยังไม่เข้าใจอยู่ดีครับ

กรณี Preview แสดงว่าต้องการจะดูการกำหนดค่าการพิมพ์ เมื่อดูแล้วก็ถือว่าเป็นอันจบ จะ Print หรือไม่ก็แล้วแต่เรา

หากต้องการจะ Save ก็ค่อยทำอีก Procedure ไม่ใช่ให้ทำทุกสั่งทุกอย่างต่อเนื่องกันไปใน Procedure เดียว การเขียน Code ควรแบ่งเป็นคำสั่งย่อย ๆ เพื่อให้ง่ายต่อการตรวจสอบ ติดตามแก้ไขและปรับปรุง Code ครับ

ลองลำดับการทำงานมาใหม่ว่าต้องการจะทำอะไรก่อนหลังครับ

[suka]

ลองลำดับการทำงานมาใหม่ว่าต้องการจะทำอะไรก่อนหลังครับ

อาจารย์คะทำตามนี้ก่อนค่ะ Code ด้านล่างนี้เมื่อวางข้อมูลที่ชีท Report ถึงเซลล์ A35 ให้ขึ้นข้อความ"คุณต้องการพิมพ์รายงานหรือไม่"เมื่อกดปุ่ม Ok แล้วต้องการให้ Pop up ชีท 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
     End With
If wbShare.Sheets("Report").Range("A35") <> "" Then
         MsgBox "คุณต้องการพิมพ์รายงานหรือไม่"
End If

เมื่อทำงานตามด้านบนเรียบร้อยแล้ว ให้ Save ไฟล์ทั้งหมดค่ะ คือไฟล์ PoWbShare ไฟล์ ArBookShare และไฟล์ AR.Form ค่ะ

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").Activate
ActiveWorkbook.Save
End Sub

[snasui]

ตาม Code ที่เขียนมาเองแล้วนั้นพบปัญหาอะไรช่วยแจ้งมาด้วยครับ

[suka]

เมื่อวางข้อมูลที่ชีท Report ถึงเซลล์ A35 แล้วขึ้นข้อความ"คุณต้องการพิมพ์รายงานหรือไม่"เมื่อกดปุ่ม Ok แล้ว
ต้องการให้ Pop up Preview ชีท Report อันนี้ยังทำไม่ได้ค่ะอาจารย์

[snasui]

ต้องการให้ PrintPreview ก็ต้องเพิ่ม Code ให้ PrintPreview เข้าไปด้วย เมื่อเพิ่มเข้าไปแล้วติดปัญหาใดสามารถถามมาได้ แต่หากว่า Preview แล้วคลิกปุ่มใด ๆ ไม่ได้นั้นผมแจ้งไปแล้วว่าเครื่องผมสามารถคลิกได้เป็นปกติครับ

[suka]

ขอบคุณค่ะอาจารย์

อาจารย์คะ Code ด้านล่างนี้ขอรบกวนอาจารย์ช่วยแนะการแบ่งให้เป็นคำสั่งย่อย ๆ ให้หน่อยค่ะ

หากต้องการจะ Save ก็ค่อยทำอีก Procedure ไม่ใช่ให้ทำทุกสั่งทุกอย่างต่อเนื่องกันไปใน Procedure เดียว การเขียน Code ควรแบ่งเป็นคำสั่งย่อย ๆ เพื่อให้ง่ายต่อการตรวจสอบ ติดตามแก้ไขและปรับปรุง 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
     End With
If wbShare.Sheets("Report").Range("A35") <> "" Then
         MsgBox "คุณต้องการพิมพ์รายงานหรือไม่"
End If
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").Activate
ActiveWorkbook.Save
End Sub

[snasui]

เราสามารถแบ่งย่อยได้เท่าที่ต้องการครับ

การแบ่งเป็นคำสั่งย่อย ๆ คือการสร้าง Procedure ใหม่ แล้วค่อยเรียกใช้ Procedure นั้น

ตัวอย่าง

Code: Select all

Sub MainCode()
   Call Code1
   Call Code2
End Sub

Sub Code1()
    MsgBox "Hello."
End Sub

Sub Code2()
    MsgBox "How are you?"
End Sub

ลองทดสอบเรียก MainCode ดูครับ

[suka]

อาจารย์คะ ลองแบ่งคำสั่งย่อยตามนี้ได้ไหมคะ

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
     End With
If wbShare.Sheets("Report").Range("A35") <> "" Then
         MsgBox "คุณต้องการพิมพ์รายงานหรือไม่"
End If
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
With Windows("PoWbShare.xlsx").Activate
    ActiveWorkbook.Save
End With
With Windows("ArBookShare.xlsx").Activate
    ActiveWorkbook.Save
End With
With Windows("AR.Form").Activate
    ActiveWorkbook.Save
End With
End Sub

[snasui]

แบ่งเองเลยครับ ติดแล้วค่อยถามกันครับ

[suka]

ขอบคุณค่ะอาจารย์

[suka]

เรียนอาจารย์ค่ะ ขอรบกวนช่วยเรื่องปรับ Code ด้านล่างนี้ค่ะ Code นี้ได้กำหนดให้ชีท Report เมื่อข้อมูลวางถึงเซลล์ A34
ให้แสดงข้อความ"คุณต้องการพิมพ์รายงานหรือไม่"การวางข้อมูล A2:A33 ใช้งานได้ดีค่ะ

Code: Select all

With formBook.Sheets("TemBilling")
         .Range("P10:W10").Resize(.Range("Y9")).Copy
        formBook.Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
        If formBook.Sheets("Report").Range("A34") <> "" Then
                MsgBox "คุณต้องการพิมพ์รายงานหรือไม่"
            Exit Sub
        End If
    End With

ติดที่ A34 ค่ะ เมื่อวางข้อมูลและแสดงข้อความ MsgBox แล้วสามารถวางข้อมูลได้ แต่ติดตรงไม่ล้างข้อมูลที่ชีท Form ค่ะ จะปรับอย่างไรให้ Code ล้างข้อมูลที่ชีท Form ให้ค่ะ

Code: Select all

formBook.Sheets("Form").Range("G4:G10,H1,I4:N10,M12").ClearContents

[snasui]

Code ที่เขียนแล้วติดเขียนไว้ตรงไหน ก่อนที่เขียนแยกออกมาควรที่จะรวมเอาไว้ใน Code หลักแล้วโพสต์มาให้ดูก่อน จะได้เห็นว่าวางไว้ถูกตำแหน่ง หรือไม่ อย่างไร

ที่บอกว่าติดดูแล้วไม่น่าจะติด เพียงแต่ไม่ได้ล้างค่าตามที่ต้องการใช่หรือไม่ครับ

[suka]

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 "Please check your data. This transaction already recorded."
            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
    wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    End With
   With formBook.Sheets("TemBilling")
         .Range("P10:W10").Resize(.Range("Y9")).Copy
        formBook.Sheets("Report").Range("A" & Rows.Count).End(xlUp) _
        .Offset(1, 0).PasteSpecial xlPasteValues
    If formBook.Sheets("Report").Range("A34") <> "" Then
                MsgBox "คุณต้องการพิมพ์รายงานหรือไม่"
            Exit Sub
        End If
    End With
       
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
With Windows("PoWbShare.xlsx").Activate
    ActiveWorkbook.Save
End With
With Windows("ArBookShare.xlsx").Activate
    ActiveWorkbook.Save
End With
With Windows("AR.Form").Activate
    ActiveWorkbook.Save
End With
End Sub

Code หลักตามนี้ค่ะอาจารย์

Code ที่เขียนแล้วติดเขียนไว้ตรงไหน ก่อนที่เขียนแยกออกมาควรที่จะรวมเอาไว้ใน Code หลักแล้วโพสต์มาให้ดูก่อน จะได้เห็นว่าวางไว้ถูกตำแหน่ง หรือไม่ อย่างไร

ที่บอกว่าติดดูแล้วไม่น่าจะติด เพียงแต่ไม่ได้ล้างค่าตามที่ต้องการใช่หรือไม่ครับ

ใช่ค่ะไม่ได้ล้างค่าที่ชีท Form ค่ะอาจารย์

[snasui]

นำ Code นี้ไปวางไว้ก่อนหน้า Exit Sub อีกที่ครับ

formBook.Sheets("Form").Range("G4:G10,H1,I4:N10,M12").ClearContents

[suka]

ขอบพระคุณค่ะอาจารย์ ใช้ได้ตามที่ต้องการแล้วค่ะ

[suka]

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

โค๊ดเพื่อสั่งปลด AutoFilter ที่ชีท PoWbShare ซึ่งมีหลายคอลัมน์ หากมีคอลัมน์ใดคอลัมน์หนึ่ง AutoFilter ไว้ก็ให้ปลดออก โค๊ดด้านล่างนี้ต้องปรับอย่างไรคะ

Code: Select all

Sub Macro6()
    Windows("PoWbShare.xlsx").Activate
    ActiveWindow.WindowState = xlNormal
    ActiveWindow.WindowState = xlNormal
    ActiveSheet.Range("$A$1:$AD$22798").AutoFilter Field:=2
    ActiveSheet.Range("$A$1:$AD$21798").AutoFilter Field:=3
    ActiveSheet.Range("$A$1:$AD$21798").AutoFilter Field:=4
    ActiveSheet.Range("$A$1:$AD$21798").AutoFilter Field:=5
End Sub

[niwat2811]

ลองแบบนี้ใช้ได้ไหมครับ

Code: Select all

Sub Macro6()
    Windows("PoWbShare.xlsx").Activate
    ActiveWindow.WindowState = xlNormal
    ActiveWindow.WindowState = xlNormal
    ActiveSheet.Range("$A$1:$AD$22798").AutoFilter Field:=2
    ActiveSheet.Range("$A$1:$AD$21798").AutoFilter Field:=3
    ActiveSheet.Range("$A$1:$AD$21798").AutoFilter Field:=4
    ActiveSheet.Range("$A$1:$AD$21798").AutoFilter Field:=5
    ActiveSheet.ShowAllData
End Sub

[suka]

ใช้ได้ค่ะ ขอบคุณมากๆค่ะคุณ niwat2811

[suka]

เราสามารถแบ่งย่อยได้เท่าที่ต้องการครับ

การแบ่งเป็นคำสั่งย่อย ๆ คือการสร้าง Procedure ใหม่ แล้วค่อยเรียกใช้ Procedure นั้น

ตัวอย่าง

Code: Select all

Sub MainCode()
Call Code1
Call Code2
End Sub

Sub Code1()
MsgBox "Hello."
End Sub

Sub Code2()
MsgBox "How are you?"
End Sub

ลองทดสอบเรียก MainCode ดูครับ

เรียนอาจารย์ค่ะ จากตัวอย่าง Code ของอาจารย์ด้านบนการแบ่งเป็นคำสั่งย่อยแล้วค่อยเรียกใช้
หากต้องการนำ Code นี้มาใช้กับ Code ทั้งชุดด้านล่างนี้ค่ะ

Code: Select all

Sub AutoFilter()
       Windows("Ph_BookShare.xlsx").Activate
       ActiveWindow.WindowState = xlNormal
       ActiveWindow.WindowState = xlNormal
       On Error Resume Next
       ActiveSheet.ShowAllData
       On Error GoTo 0
       ActiveWorkbook.Save
End Sub

ความต้องการให้ Code ปลด AutoFilter ที่ไฟล์ Ph_BookShare ก่อนหากมี AutoFilter ไว้แล้วค่อยวางข้อมูลใหม่ค่ะ
ขอรบกวนช่วยจะปรับอย่างใดค่ะ

Code: Select all

Sub PasteData()
        Dim wbShare As Workbook
        Dim formBook As Workbook
        Dim i As Integer
        Dim e As Long
        Dim rs As Range
        Dim rt As Range
        Set formBook = ThisWorkbook
        Set wbShare = Workbooks("Ph_BookShare.xlsx")
        With wbShare
                 e = wbShare.Sheets("Sheet1").Range("e" & Rows.Count).End(xlUp).Value   '
         End With
        wbShare.Save '<== Add this line for refresh shareworkbook
        Application.ScreenUpdating = False
            With formBook
                     i = Worksheets("Enterthedata").Range("C224")
            End With
            With Worksheets("Template")
                    Set rs = .Range(.Range("A2"), .Range("AF" & i + 1))
            End With

        Set rt = wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        If Worksheets("Enterthedata").Range("C224") = True Then
                MsgBox "Please check your data. This transaction already recorded."
            Exit Sub
        End If
  
            If Worksheets("Enterthedata").Range("B204") = "" Then
                    MsgBox "Your data is empty. Fill your data and click record button again."
            Exit Sub
        End If
        rs.Copy: rt.PasteSpecial xlPasteValues
        wbShare.Save '<==Save after record data
        formBook.Save

            Application.CutCopyMode = False
            Sheets("Enterthedata").Range("D2,K2,B204:B219,D204:D219,L204:L219,D221,E221,E204:F219,L204:M219,O204:O219").ClearContents
        With Worksheets("Enterthedata")
                .Range("N1") = .Range("N1") + 1
        End With
End Sub