Page 1 of 1
ขอช่วยปรับ VBA ให้เปิดไฟล์พร้อมวางข้อมูลค่ะ
Posted: Tue Jun 23, 2015 8:45 pm
by suka
เรียนอาจารย์และท่านผู้รู้ช่วยปรับโค๊ดค่ะ
จากไฟล์แนบเมื่อกดปุ่ม Record ที่ไฟล์ PO ชีท Enterthedata ต้องการนำโค๊ด SOpenDB มาใช้ร่วมกับ MainCode ไม่สามารถปรับใช้ได้ค่ะ พอใส่ Call SOpenDB ไว้ที่โค๊ด MainCode ก็ฟ้องตามรูปแนบค่ะ
สิ่งที่ต้องการค่ะ
เมื่อกด Record แล้วต้องการให้โค๊ดเปิดไฟล์ DB แล้วนำข้อมูลจากไฟล์ PO ชีท Enterthedata ไปวางที่ไฟล์ DB ชีท Sheet1 และ ที่ไฟล์ PO ชีท Database เมื่อวางข้อมูลเรียบร้อยแล้วให้ปิดไฟล์ DB ค่ะ โค๊ดนำข้อมูลมาวางได้ตรงตามต้องการค่ะ ที่ยังไม่ได้ตามต้องการคือที่อักษรสีแดงค่ะ ขอบคุณค่ะ
Re: ขอช่วยปรับ VBA ให้เปิดไฟล์พร้อมวางข้อมูลค่ะ
Posted: Wed Jun 24, 2015 8:36 am
by puriwutpokin
ลองปรับเป็นแบบนี้ครับ ในpath Set wdShare = Workbooks.Open("C:\Folder\DB.xlsx")
Re: ขอช่วยปรับ VBA ให้เปิดไฟล์พร้อมวางข้อมูลค่ะ
Posted: Wed Jun 24, 2015 9:36 am
by 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
Re: ขอช่วยปรับ VBA ให้เปิดไฟล์พร้อมวางข้อมูลค่ะ
Posted: Wed Jun 24, 2015 9:52 am
by 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 ซ้ำกันหรือเปล่าครับ
Re: ขอช่วยปรับ VBA ให้เปิดไฟล์พร้อมวางข้อมูลค่ะ
Posted: Wed Jun 24, 2015 10:24 am
by puriwutpokin
Set wdShare = Workbooks.Open("C:\Folder\DB.xlsx") "C:\Folder" คือแต่งแหน่งที่เก็บของไฟล์ DB.xlsx ต้องหาตำแหน่งที่เก็บไฟล์ ไม่ใช่เอาค่านี้ไปใช้เลยครับ อาจจะ ไว้ไฟล์ที่ "C:\ชื่อโฟล์เดอร์\DB.xlsx"
หรือ ตำแหน่งตัวอย่างแบบนี้ D:\FlashDrive\Knowledge\Book study\DB.xlsx
Re: ขอช่วยปรับ VBA ให้เปิดไฟล์พร้อมวางข้อมูลค่ะ
Posted: Wed Jun 24, 2015 11:19 am
by suka
เอาโค๊ดที่ซ้ำออกไม่ฟ้องแล้วค่ะ ขอบคุณคุณ niwat2811 มากๆค่ะ
ปรับตำแหน่งที่เก็บไฟล์ใหม่โค๊ดใช้ได้ตรงตามต้องการแล้วค่ะ ขอบคุณคุณ puriwutpokin มากๆค่ะ