ขอช่วยปรับ VBA ให้เปิดไฟล์พร้อมวางข้อมูลค่ะ

[suka]

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

จากไฟล์แนบเมื่อกดปุ่ม Record ที่ไฟล์ PO ชีท Enterthedata ต้องการนำโค๊ด SOpenDB มาใช้ร่วมกับ MainCode ไม่สามารถปรับใช้ได้ค่ะ พอใส่ Call SOpenDB ไว้ที่โค๊ด MainCode ก็ฟ้องตามรูปแนบค่ะ

สิ่งที่ต้องการค่ะ

เมื่อกด Record แล้วต้องการให้โค๊ดเปิดไฟล์ DB แล้วนำข้อมูลจากไฟล์ PO ชีท Enterthedata ไปวางที่ไฟล์ DB ชีท Sheet1 และ ที่ไฟล์ PO ชีท Database เมื่อวางข้อมูลเรียบร้อยแล้วให้ปิดไฟล์ DB ค่ะ โค๊ดนำข้อมูลมาวางได้ตรงตามต้องการค่ะ ที่ยังไม่ได้ตามต้องการคือที่อักษรสีแดงค่ะ ขอบคุณค่ะ

[puriwutpokin]

ลองปรับเป็นแบบนี้ครับ ในpath Set wdShare = Workbooks.Open("C:\Folder\DB.xlsx")

[suka]

ยังไม่ได้ค่ะฟ้องตามรูปเดิมค่ะคุณ puriwutpokin นำโค๊ด

Code: Select all

Set wdShare = Workbooks.Open("C:\Folder\DB.xlsx")

ไปไว้ที่ MainCode ฟ้องตามรูปเดิมค่ะ

Code: Select all

Sub MainCode()
        Dim formBook As Workbook
        Dim wdShare As Workbook
        Dim response As Integer
        Dim r As Range
        Set formBook = ThisWorkbook
        Set wdShare = Workbooks("DB.xlsx")
        Set r = formBook.Sheets("Enterthedata").Range("K1")
        Set wdShare = Workbooks.Open("C:\Folder\DB.xlsx")
        Application.ScreenUpdating = False
            If Application.CountIf(wdShare.Sheets("Sheet1").Range("F:F"), r) <> 0 Then
                        MsgBox "โปรดตรวจสอบเลขที่เอกสารนี้ได้บันทึกแล้ว รายการซ้ำ "
                Exit Sub
            End If
                Call SOpenDB
                Call PasteData
                Call MainCodeDBCopy
                Call SCloseDB
        Application.ScreenUpdating = True
End Sub

และเมื่อนำไปวางที่ SOpenDB ก็ฟ้องเช่นเดิมค่ะ

Code: Select all

Sub SOpenDB()
        Dim wbOpen As Boolean    '<== สำหรับสั่งให้เปิดไฟล์ DB.xlsx
        Dim wb As Workbook
        Set wd = Workbooks.Open("C:\Folder\DB.xlsx")
            For Each wb In Workbooks
                If wb.Name = "DB.xlsx" Then
                    wbOpen = True
                End If
            Next wb
            If Not wbOpen Then
                    ChDir "C:\Documents and Settings\Administrator\Desktop\Po"
                    Workbooks.Open Filename:="C:\Documents and Settings\Administrator\Desktop\Po\DB.xlsx", UpdateLinks:=0
            End If
End Sub

[niwat2811]

Code: Select all

Sub MainCode()
        Dim formBook As Workbook
        Dim wdShare As Workbook
        Dim response As Integer
        Dim r As Range
        Set formBook = ThisWorkbook
        'Set wdShare = Workbooks("DB.xlsx") <== ตัวนี้ซ้ำกับตัวข้างล่างครับ
        Set r = formBook.Sheets("Enterthedata").Range("K1")
        Set wdShare = Workbooks.Open("C:\Folder\DB.xlsx")
        Application.ScreenUpdating = False
            If Application.CountIf(wdShare.Sheets("Sheet1").Range("F:F"), r) <> 0 Then
                        MsgBox "โปรดตรวจสอบเลขที่เอกสารนี้ได้บันทึกแล้ว รายการซ้ำ "
                Exit Sub
            End If
                Call SOpenDB
                Call PasteData
                Call MainCodeDBCopy
                Call SCloseDB
        Application.ScreenUpdating = True
End Sub

Set wdShare ซ้ำกันหรือเปล่าครับ

[puriwutpokin]

Set wdShare = Workbooks.Open("C:\Folder\DB.xlsx") "C:\Folder" คือแต่งแหน่งที่เก็บของไฟล์ DB.xlsx ต้องหาตำแหน่งที่เก็บไฟล์ ไม่ใช่เอาค่านี้ไปใช้เลยครับ อาจจะ ไว้ไฟล์ที่ "C:\ชื่อโฟล์เดอร์\DB.xlsx"
หรือ ตำแหน่งตัวอย่างแบบนี้ D:\FlashDrive\Knowledge\Book study\DB.xlsx

[suka]

เอาโค๊ดที่ซ้ำออกไม่ฟ้องแล้วค่ะ ขอบคุณคุณ niwat2811 มากๆค่ะ

ปรับตำแหน่งที่เก็บไฟล์ใหม่โค๊ดใช้ได้ตรงตามต้องการแล้วค่ะ ขอบคุณคุณ puriwutpokin มากๆค่ะ