อยากยกเลิกหน้าต่างเวลาดึงไฟล์แล้วไม่พบไฟล์ข้อมูล

[yangkodza]

Code: Select all

Sub Macro1()
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "='[รายชื่อประถม.xlsx]ป.1-1'!R[1]C"
    Selection.AutoFill Destination:=Range("B2:E2"), Type:=xlFillDefault
    Range("B2:E2").Select
    Selection.AutoFill Destination:=Range("B2:E51")
    Range("B2:E51").Select
    Range("A1").Select
End Sub

จาก Code ข้างต้น โปรแกรมดึงข้อมูลมาได้ปกติ
แต่อยากจะปรับ Code ให้ว่า
ถ้าไม่เจอไฟล์ดังกล่าว ก็ไม่ต้องดึงข้อมูล
เพราะถ้าไม่เจอไฟล์ จะฟ้องหน้าต่างถามหาไฟล์เลยไม่อยากให้ถามครับ

รบกวนช่วยปรับ Code ให้หน่อยครับ

ดึงไฟล์.rar

[snasui]

ตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

Sub Macro1()
    Range("B2").Select
    On Error Resume Next
    Set wb = Workbooks("รายชื่อประถม.xlsx")
    If Err <> 0 Then Exit Sub
    ActiveCell.FormulaR1C1 = "='[รายชื่อประถม.xlsx]ป.1-1'!R[1]C"
    Selection.AutoFill Destination:=Range("B2:E2"), Type:=xlFillDefault
    Range("B2:E2").Select
    Selection.AutoFill Destination:=Range("B2:E51")
    Range("B2:E51").Select
    Range("A1").Select
End Sub

[yangkodza]

ตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

Sub Macro1()
    Range("B2").Select
    On Error Resume Next
    Set wb = Workbooks("รายชื่อประถม.xlsx")
    If Err <> 0 Then Exit Sub
    ActiveCell.FormulaR1C1 = "='[รายชื่อประถม.xlsx]ป.1-1'!R[1]C"
    Selection.AutoFill Destination:=Range("B2:E2"), Type:=xlFillDefault
    Range("B2:E2").Select
    Selection.AutoFill Destination:=Range("B2:E51")
    Range("B2:E51").Select
    Range("A1").Select
End Sub

อาจารย์ครับ ผมนำ Code ไปใช้ แต่ไม่มีการแสดงผลอะไรครับ
ในขณะที่ไฟล์ฐานข้อมูลยังอยู่ ไม่สามารถดึงข้อมูลได้ครับ

Code ที่ใช้ครับ

Code: Select all

Sub Macro3()
    Range("B2").Select
    On Error Resume Next
    Set wb = Workbooks("รายชื่อประถม.xlsx")
    If Err <> 0 Then Exit Sub
    ActiveCell.FormulaR1C1 = "='[รายชื่อประถม.xlsx]ป.1-1'!R[1]C"
    Selection.AutoFill Destination:=Range("B2:E2"), Type:=xlFillDefault
    Range("B2:E2").Select
    Selection.AutoFill Destination:=Range("B2:E51")
    Range("B2:E51").Select
    Range("A1").Select
End Sub

[yangkodza]

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

[yangkodza]

อาจารย์ครับ รบกวนสอบถามเพิ่มเติมครับ
Code ที่ใช้อยู่จริงเราดึงข้อมูลมาจากหลายไฟล์
ดัง code แนบ

Code: Select all

Sub ดึงคะแนนเทอม1()
    Range("J2").Select      ' คะแนนสังคม เทอม1
    ActiveCell.FormulaR1C1 = "=[01_สังคมศึกษา_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[32]"
    Selection.AutoFill Destination:=Range("j2:j51")
        Range("L2").Select      ' คะแนนสุขศึกษา เทอม1
    ActiveCell.FormulaR1C1 = "=[02_สุขศึกษา_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[30]"
    Selection.AutoFill Destination:=Range("L2:L51")
            Range("M2").Select      ' คะแนนศิลปะ เทอม1
    ActiveCell.FormulaR1C1 = "=[03_ศิลปะ_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[29]"
    Selection.AutoFill Destination:=Range("M2:M51")
            Range("N2").Select      ' คะแนนศิลปะ เทอม1
    ActiveCell.FormulaR1C1 = "=[04_กอท_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[28]"
    Selection.AutoFill Destination:=Range("N2:N51")
            Range("O2").Select      ' คะแนนภาษาอังกฤษ เทอม1
    ActiveCell.FormulaR1C1 = "=[05_ภาษาอังกฤษ_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[27]"
    Selection.AutoFill Destination:=Range("O2:O51")
            Range("P2").Select      ' คะแนนคอมพิวเตอร์ เทอม1
    ActiveCell.FormulaR1C1 = "=[06_คอมพิวเตอร์_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[26]"
    Selection.AutoFill Destination:=Range("P2:P51")
            Range("Q2").Select      ' คะแนนภาษาอังกฤษเพื่อการสื่อสาร เทอม1
    ActiveCell.FormulaR1C1 = "=[07_ภาษาอังกฤษเพื่อการสื่อสาร_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[25]"
    Selection.AutoFill Destination:=Range("Q2:Q51")
            Range("R2").Select      ' คะแนนหน้าที่พลเมือง เทอม1
    ActiveCell.FormulaR1C1 = "=[08_หน้าที่พลเมือง_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[24]"
    Selection.AutoFill Destination:=Range("R2:R51")
    End Sub
Sub ดึงคะแนนเทอม2()
    Range("J2").Select      ' คะแนนสังคม เทอม2
    ActiveCell.FormulaR1C1 = "=[01_สังคมศึกษา_ป.1_เทอม2.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[32]"
    Selection.AutoFill Destination:=Range("j2:j51")
        Range("L2").Select      ' คะแนนสุขศึกษา เทอม2
    ActiveCell.FormulaR1C1 = "=[02_สุขศึกษา_ป.1_เทอม2.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[30]"
    Selection.AutoFill Destination:=Range("L2:L51")
            Range("M2").Select      ' คะแนนศิลปะ เทอม2
    ActiveCell.FormulaR1C1 = "=[03_ศิลปะ_ป.1_เทอม2.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[29]"
    Selection.AutoFill Destination:=Range("M2:M51")
            Range("N2").Select      ' คะแนนศิลปะ เทอม2
    ActiveCell.FormulaR1C1 = "=[04_กอท_ป.1_เทอม2.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[28]"
    Selection.AutoFill Destination:=Range("N2:N51")
            Range("O2").Select      ' คะแนนภาษาอังกฤษ เทอม2
    ActiveCell.FormulaR1C1 = "=[05_ภาษาอังกฤษ_ป.1_เทอม2.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[27]"
    Selection.AutoFill Destination:=Range("O2:O51")
            Range("P2").Select      ' คะแนนคอมพิวเตอร์ เทอม2
    ActiveCell.FormulaR1C1 = "=[06_คอมพิวเตอร์_ป.1_เทอม2.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[26]"
    Selection.AutoFill Destination:=Range("P2:P51")
            Range("Q2").Select      ' คะแนนภาษาอังกฤษเพื่อการสื่อสาร เทอม2
    ActiveCell.FormulaR1C1 = "=[07_ภาษาอังกฤษเพื่อการสื่อสาร_ป.1_เทอม2.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[25]"
    Selection.AutoFill Destination:=Range("Q2:Q51")
            Range("R2").Select      ' คะแนนหน้าที่พลเมือง เทอม2
    ActiveCell.FormulaR1C1 = "=[08_หน้าที่พลเมือง_ป.1_เทอม2.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[24]"
    Selection.AutoFill Destination:=Range("R2:R51")
    End Sub

เราสามารถใช้

Code: Select all

 On Error Resume Next
    Set wb = Workbooks("รายชื่อประถม.xlsx")
    If Err <> 0 Then Exit Sub

แล้วแก้บบรรทัด

Code: Select all

Set wb = Workbooks("รายชื่อประถม.xlsx")

อย่างเดียว แล้วเพิ่มบรรทัดใช่ไหมครับ

[snasui]

ลองทำได้เลย ติดตรงไหนแล้วค่อยถามกันได้เรื่อย ๆ อย่าพยายามถามต่อโดยไม่ได้ลอง เพราะอาจจะรอคำตอบนานครับ

[yangkodza]

ลองทำได้เลย ติดตรงไหนแล้วค่อยถามกันได้เรื่อย ๆ อย่าพยายามถามต่อโดยไม่ได้ลอง เพราะอาจจะรอคำตอบนานครับ

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

Code: Select all

Sub ดึงคะแนนเทอม1()

    Range("J2").Select      ' คะแนนสังคม เทอม1
    On Error Resume Next
    Set wb1 = Workbooks("01_สังคมศึกษา_ป.1_เทอม1.xls")
    If Err <> 0 Then GoTo สุขศึกษา
    ActiveCell.FormulaR1C1 = "=[01_สังคมศึกษา_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[32]"
    Selection.AutoFill Destination:=Range("j2:j51")
    
สุขศึกษา:
        Range("L2").Select      ' คะแนนสุขศึกษา เทอม1
    On Error Resume Next
    Set wb2 = Workbooks("02_สุขศึกษา_ป.1_เทอม1.xls")
    If Err <> 0 Then GoTo ศิลปะ
    ActiveCell.FormulaR1C1 = "=[02_สุขศึกษา_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[30]"
    Selection.AutoFill Destination:=Range("L2:L51")
    
ศิลปะ:
            Range("M2").Select      ' คะแนนศิลปะ เทอม1
    On Error Resume Next
    Set wb = Workbooks("03_ศิลปะ_ป.1_เทอม1.xls")
    If Err <> 0 Then GoTo กอท
    ActiveCell.FormulaR1C1 = "=[03_ศิลปะ_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[29]"
    Selection.AutoFill Destination:=Range("M2:M51")
    
กอท:
            Range("N2").Select      ' คะแนนกอท เทอม1
    On Error Resume Next
    Set wb = Workbooks("04_กอท_ป.1_เทอม1.xls")
    If Err <> 0 Then GoTo ภาษาอังกฤษ
    ActiveCell.FormulaR1C1 = "=[04_กอท_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[28]"
    Selection.AutoFill Destination:=Range("N2:N51")
    
ภาษาอังกฤษ:
            Range("O2").Select      ' คะแนนภาษาอังกฤษ เทอม1
    On Error Resume Next
    Set wb = Workbooks("05_ภาษาอังกฤษ_ป.1_เทอม1.xls")
    If Err <> 0 Then GoTo คอมพิวเตอร์
    ActiveCell.FormulaR1C1 = "=[05_ภาษาอังกฤษ_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[27]"
    Selection.AutoFill Destination:=Range("O2:O51")
    
คอมพิวเตอร์:
            Range("P2").Select      ' คะแนนคอมพิวเตอร์ เทอม1
    On Error Resume Next
    Set wb = Workbooks("06_คอมพิวเตอร์_ป.1_เทอม1.xls")
    If Err <> 0 Then GoTo ภาษาอังกฤษเพื่อการสื่อสาร
    ActiveCell.FormulaR1C1 = "=[06_คอมพิวเตอร์_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[26]"
    Selection.AutoFill Destination:=Range("P2:P51")
    
ภาษาอังกฤษเพื่อการสื่อสาร:
            Range("Q2").Select      ' คะแนนภาษาอังกฤษเพื่อการสื่อสาร เทอม1
    On Error Resume Next
    Set wb = Workbooks("07_ภาษาอังกฤษเพื่อการสื่อสาร_ป.1_เทอม1.xls")
    If Err <> 0 Then GoTo หน้าที่พลเมือง
    ActiveCell.FormulaR1C1 = "=[07_ภาษาอังกฤษเพื่อการสื่อสาร_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[25]"
    Selection.AutoFill Destination:=Range("Q2:Q51")
    
หน้าที่พลเมือง:
            Range("R2").Select      ' คะแนนหน้าที่พลเมือง เทอม1
    On Error Resume Next
    Set wb = Workbooks("08_หน้าที่พลเมือง_ป.1_เทอม1.xls")
    If Err <> 0 Then GoTo จบ
    ActiveCell.FormulaR1C1 = "=[08_หน้าที่พลเมือง_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[24]"
    Selection.AutoFill Destination:=Range("R2:R51")
จบ:
    End Sub

รบกวนอาจารย์ชี้แนะด้วยครับ

[snasui]

ลอง Run ทีละ Step โดยกดแป้น F8 ซ้ำ ๆ แล้วแจ้งมาว่าติดขัดที่บรรทัดใดครับ

[yangkodza]

ลอง Run ทีละ Step โดยกดแป้น F8 ซ้ำ ๆ แล้วแจ้งมาว่าติดขัดที่บรรทัดใดครับ

ผ่านหมดครับแต่กลายเป็นไม่ดึงคะแนน
ผมตั้งให้ว่า ถ้า ไม่เจอไฟล์ก็ให้กระโดดไป หาไฟล์ต่อไป
ผมเขียน code ถูกไหมครับ

ตอนนี้ code พอวิ่งไปถึง go to กระโดดไปเลย ยังไม่ทันจะดึงคะแนนเลยครับ
ทั้งๆที่ชื่อไฟล์ก็ถูกต้องครับผม

Code: Select all

Range("J2").Select      ' คะแนนสังคม เทอม1
    On Error Resume Next
    Set wb = Workbooks("01_สังคมศึกษา_ป.1_เทอม1.xls")
    If Err <> 0 Then GoTo สุขศึกษา
    ActiveCell.FormulaR1C1 = "=[01_สังคมศึกษา_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[32]"
    Selection.AutoFill Destination:=Range("j2:j51")
    
สุขศึกษา:
        Range("L2").Select      ' คะแนนสุขศึกษา เทอม1
    On Error Resume Next
    Set wb = Workbooks("02_สุขศึกษา_ป.1_เทอม1.xls")
    If Err <> 0 Then GoTo ศิลปะ
    ActiveCell.FormulaR1C1 = "=[02_สุขศึกษา_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[30]"
    Selection.AutoFill Destination:=Range("L2:L51")

เริ่มไปไม่รอดแล้วครับ

[snasui]

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

Code: Select all

'---Other code---
     Range("J2").Select      ' คะแนนสังคม เทอม1
    On Error Resume Next
    Set wb1 = Workbooks("01_สังคมศึกษา_ป.1_เทอม1.xls")
    If Err <> 0 Then
        Err.Clear
        GoTo สุขศึกษา
    End If
    ActiveCell.FormulaR1C1 = "=[01_สังคมศึกษา_ป.1_เทอม1.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[32]"
    Selection.AutoFill Destination:=Range("j2:j51")
    '---Other code---

[yangkodza]

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

ยังหาทางออกไม่ได้ครับ รบกวนชี้แนะด้วยครับ

[snasui]

ก็ต้องเปิดไฟล์ต้นทางเสียก่อนครับ หรือหากจะทำงานกับไฟล์ไหนก็ให้เปิดไฟล์นั้นไว้ก่อน หรือจะเปิดด้วย Code ก็ย่อมได้ครับ