EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
[code]
และปิดด้วย [/code]
ตัวอย่างเช่น [code]dim r as range[/code]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)Code: Select all
Sub Extract_Data_from_PDF()
Application.Cells.Clear
Application.CutCopyMode = False
Worksheets("ExtractPDF").Activate
Range("A:A").Clear
Set MyWorksheet = ActiveWorkbook.Worksheets("ExtractPDF")
Application_Path = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"
PDF_Path = "\\internal.local\Shares\Dept\MISNonAgencyRobot\Bancassurance\Monthly_Approval_Report\2023\202304\Compensation\Sample.pdf"
Shell_Path = Application_Path & " """ & PDF_Path & """"
Call Shell(pathname:=Shell_Path, windowstyle:=vbNormalFocus)
Application.Wait Now + TimeValue("0:00:03")
'SendKeys "%vpc"
SendKeys "^a"
SendKeys "^c"
Worksheets("ExtractPDF").Activate
Range("A1").PasteSpecial Paste:=xlPasteAll
Call Shell("TaskKill /IM AcroRd32.exe", vbHide)
End Sub
ไม่ทราบว่ากรณีเช่นนี้ต้องการให้แสดงผลเช่นไร สมมุติไม่ต้องการให้แสดง Error สามารถใช้ StatementPolly wrote: Tue May 30, 2023 4:48 pm เมื่อ User ใช้งานจากไฟล์อื่นโดยก๊อบปี้ไฟล์ค้างไว้ หรือการเลือก copy ที่ไฟล์นี้แต่ไม่ได้ paste ให้เรียบร้อย เมื่อคลิกรันอีกทีจะทำให้พบ error ซึ่งทำให้เกิด popup แจ้ง Run-time error '1004' PasteSpecial method of Range class failed ค้างที่สเต็ป paste special ค่ะ
On Error Resume Next
ดักเอาไว้ในบรรทัดบน ๆ เพื่อปิด Errorapplication.cutcopymode = false
วางไว้บรรทัดบน ๆ เพื่อยกเลิกการ Copy ค้างไว้Code: Select all
Sub Extract_Data_from_PDF()
'On Error Resume Next
Worksheets("ExtractPDF").Activate
Application.CutCopyMode = False
Range("A:A").Clear
Set MyWorksheet = ActiveWorkbook.Worksheets("ExtractPDF")
Application_Path = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"
PDF_Path = "\\internal.local\Shares\Dept\MISNonAgencyRobot\Bancassurance\Monthly_Approval_Report\2023\202304\Compensation\Sample.pdf"
Shell_Path = Application_Path & " """ & PDF_Path & """"
Call Shell(pathname:=Shell_Path, windowstyle:=vbNormalFocus)
Application.Wait Now + TimeValue("0:00:03")
'SendKeys "%vpc"
SendKeys "^a"
SendKeys "^c"
Worksheets("ExtractPDF").Activate
Range("A1").PasteSpecial Paste:=xlPasteAll
'Call Shell("TaskKill /F /IM AcroRd32.exe", vbHide)
Call Shell("TaskKill /IM AcroRd32.exe", vbHide)
End Sub
Worksheets("ExtractPDF").Activate
จากนั้นสั่ง Run Code ถ้าทำการ Break ถูกต้องบรรทัดสีหลืองใน Code จะต้องมาหยุดอยู่ที่บรรทัดดังกล่าว จากนั้นลองเข้าไปดูที่ Clipboard ว่ามีค่าใด ๆ อยู่หรือไม่ หาก Code ทำงานถูกต้องจะต้องมีค่าใน Clipboard ถ้าไม่มีค่าใด ๆ แสดงว่าการ Copy มาโดย SendKeys
ไม่ได้ผล เมื่อ Copy ไม่ได้ผลก็ไมมีค่าที่จะวางจึงทำให้เกิด Error ครับCode: Select all
'On Error Resume Next
Worksheets("Control").Activate
Application.CutCopyMode = False
Range("A:A").Clear
Set MyWorksheet = ActiveWorkbook.Worksheets("Control")
Application_Path = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"
PDF_Path = "\\internal.local\Shares\Dept\MISNonAgencyRobot\Bancassurance\Monthly_Approval_Report\2023\202304\Compensation\Sample.pdf"
Shell_Path = Application_Path & " """ & PDF_Path & """"
Call Shell(pathname:=Shell_Path, windowstyle:=vbNormalFocus)
Application.Wait Now + TimeValue("0:00:03")
SendKeys "^a"
SendKeys "^c"
Workbooks.Open "\\internal.local\Shares\Dept\MISNonAgencyRobot\Bancassurance\Process Improvement\Test.xlsx"
Worksheets("ExtractPDF").Activate
Range("A:A").Clear
Range("A1").Select
Range("A1").PasteSpecial Paste:=xlPasteAll
Call Shell("TaskKill /IM AcroRd32.exe", vbHide)
ActiveWorkbook.Close SaveChanges:=True
End Sub