copy sheet จาก Workbooks สำรอง ไปยัง Workbooks หลัก
Posted: Fri May 08, 2015 4:33 pm
ผมต้องการ copy sheet จาก Workbooks สำรอง ไปยัง Workbooks หลัก
แต่ผมติดอยู่ตรง module
รบกวนให้คำแนะนำได้ไหมคับ
Sub copysheet()
Dim info
info = IsWorkBookOpen("C:\tanasan\Desktop\Marketing.xlsx")
If info = True Then
MsgBox "File is being used"
Else
MsgBox "File is closed"
End If
If info = False Then
Workbooks.Open FileName:="C:\Users\tanasan\Desktop\Marketing.xlsx"
End If
Sheets("d").Copy After:=Workbooks("AndonBoard.xlsx")
Sheets(Sheets.Count).neme = InputBox("Assign a new name")
Workbooks("Marketing.xlsx").Close
End Sub
Function IsWorkBookOpen(FileName As String)
Dim FF As Integer, ErrNum As Integer
On Error Resume Next
FF = FreeFile()
Open FileName For Input Lock Read As #FF
Close FF
ErrNum = Error
On Error GoTo 0
Select Case ErrNum
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNum
End Select
End Function
พอ debug ดูติดอยู่ตรง (ตัวอักษรสีแดง)
แต่ผมติดอยู่ตรง module
รบกวนให้คำแนะนำได้ไหมคับ
Sub copysheet()
Dim info
info = IsWorkBookOpen("C:\tanasan\Desktop\Marketing.xlsx")
If info = True Then
MsgBox "File is being used"
Else
MsgBox "File is closed"
End If
If info = False Then
Workbooks.Open FileName:="C:\Users\tanasan\Desktop\Marketing.xlsx"
End If
Sheets("d").Copy After:=Workbooks("AndonBoard.xlsx")
Sheets(Sheets.Count).neme = InputBox("Assign a new name")
Workbooks("Marketing.xlsx").Close
End Sub
Function IsWorkBookOpen(FileName As String)
Dim FF As Integer, ErrNum As Integer
On Error Resume Next
FF = FreeFile()
Open FileName For Input Lock Read As #FF
Close FF
ErrNum = Error
On Error GoTo 0
Select Case ErrNum
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNum
End Select
End Function
พอ debug ดูติดอยู่ตรง (ตัวอักษรสีแดง)