ค่ะอาจารย์ Code ที่ใช้ในไฟล์นี้ทั้งหมดค่ะ
Code: Select all
Sub MainCode()
Dim wdShareOpen As Boolean
Dim ArShareOpen As Boolean
Dim wdShare As Workbook
Dim ArShare As Workbook
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wdShare = Workbooks.Open("E:\My P S Project.xls\PS.BookShare.2\AR.ระบบลูกหนี้.2\VBA\PoWbShare.xlsx", False, False)
Set ArShare = Workbooks.Open("E:\My P S Project.xls\PS.BookShare.2\AR.ระบบลูกหนี้.2\VBA\ArBill_Share.xlsx", False, False)
Call SubCode_BillingDetails 'นำข้อมูลไปวางที่ไฟล์ ArBillBookShare.xlsx ชีท Sheet1 คอลัมน์ A2:D
Call ArBilling
Call Database_Copy
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
ที่นำข้อมูลไปไว้ที่ไฟล์ ArBillBookShare.xlsx ใช้สอง Code ค่ะ
Code: Select all
Sub SubCode_BillingDetails()
'นำข้อมูลไปวางที่ไฟล์ ArBillBookShare.xlsx ชีท Sheet1 คอลัมน์ A2:D
Dim formBook As Workbook
Dim dtShare As Workbook
Dim mr As Range
Dim i As Double
Set formBook = ThisWorkbook
Set dtShare = Workbooks("ArBill_Share.xlsx")
Set mr = dtShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
With formBook.Sheets("Form")
i = (.Range("P9") + .Range("M12"))
If i <> .Range("J12") Then
Exit Sub
End If
End With
With formBook.Sheets("Tem")
.Range("F20:I20").Resize(.Range("J19")).Copy
dtShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
.Offset(1, 0).PasteSpecial xlPasteValues
End With
End Sub
และ
Code: Select all
Sub ArBilling()
'Dim wdShareOpen As Boolean
Dim wdShare As Workbook
Dim formBook As Workbook
Dim wbShare As Workbook
Dim wb As Workbook ' declare wb as workbook
Dim rSource As Range
Dim rTarget As Range
Dim rs As Range
Dim rt As Range
Dim i As Double
Dim lastRow As Long
Dim shRange As Range
Set formBook = ThisWorkbook
Set wbShare = Workbooks("ArBill_Share")
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
End If
Set wdShare = Workbooks("PoWbShare.xlsx") 'set wdShare after open not before open
With formBook.Sheets("Form")
Set rSource = .Range("B3:B10")
End With
With wdShare.Sheets("Sheet1")
Set rTarget = .Range("F2", .Range("F" & Rows.Count).End(xlUp))
End With
With formBook.Sheets("Form")
i = (.Range("P9") + .Range("M12"))
If i <> .Range("J12") Then
MsgBox "โปรดตรวจจำนวนเงินและบันทึกใหม่"
Exit Sub
End If
End With
For Each rs In rSource
For Each rt In rTarget
If rt = rs Then rt.Offset(0, 26) = "B"
Next rt
Next rs
With formBook.Sheets("Tem")
.Range("A2:N2").Resize(.Range("Q1")).Copy
wbShare.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp) _
.Offset(0, 4).PasteSpecial xlPasteValues
End With
'formBook.Sheets("Form").Range("H1,J4:O8,M12").ClearContents
With formBook.Sheets("Form")
.Range("j2") = .Range("j2") + 1
.Range("i4") = .Range("i4") + 1
End With
wbShare.Save
wbShare.Close
End Sub
Code นี้ใช้เพื่อ Copy ข้อมูลมาไว้ชีท Database ไฟล์ Book ค่ะ
Code: Select all
Sub Database_Copy()
Dim wbShare As Workbook
Dim formBook As Workbook
Set formBook = ThisWorkbook
Set wbShare = Workbooks("PoWbShare.xlsx")
ActiveSheet.UsedRange.Copy
formBook.Activate
Sheets("Database").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
wbShare.Save
wbShare.Close
Sheets("Form").Select
End Sub
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
