Page 1 of 1

การเปิดไฟล์ด้วย VBA

Posted: Mon Mar 26, 2018 2:26 pm
by Daboynut
สวัสดีครับ ผมได้เขียนงานที่ใช้ vba ขึ้นมา ซึ่งไฟล์ 1.xlsm เป็นไฟล์ data ดิบ มีสูตรค้นหารายชื่อพนักงาน ไฟล์ที่ 2.xlsm เป็นไฟล์ที่ใช้งานเพื่อทำการ add data จาก ไฟล์ 1.xlsm ไปที่ sheet2 ของไฟล์ 2.xlsm เมื่อ add ข้อมูล จะต้องต่อการเป็นรายชื่อลงมา

ต้องการให้ ปรับ code vba ให้งานสามารถเปิดงานจากชื่อไฟล์ชื่อใดก็ได้ เพราะใน code vba ผมเขียนให้มันเปิดจากชื่อไฟล์เลยครับ
ยังเปิดไฟล์ชื่อต่างๆกันไม่ได้ครับ รบกวนด้วยครับ

Re: การเปิดไฟล์ด้วย VBA

Posted: Mon Mar 26, 2018 10:16 pm
by snasui
:D ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub addvalue()
    Dim NextRow As Integer
    '
    ' addvalue Macro
    '
    ' Keyboard Shortcut: Ctrl+a
    '
    Dim filePath As String, wb As Workbook
    filePath = Application.GetOpenFilename( _
        filefilter:="Excel File (*.xls*),*.xls*", _
        Title:="Open file", _
        MultiSelect:=False)
        
        If filePath = "false" Then Exit Sub
    Set wb = Workbooks.Open(filePath)
'    Windows("1.xlsm").Activate
    Range("E5:G5").Select
    Selection.Copy
    Windows("2.xlsm").Activate
    Sheets("Sheet2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "m/d/yyyy""  ""h\:mm\:ss AM/PM"
    NextRow = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1   '# To find next row
    Cells(NextRow, 1).Select
End Sub

Re: การเปิดไฟล์ด้วย VBA

Posted: Tue Mar 27, 2018 10:02 am
by Daboynut
snasui wrote: Mon Mar 26, 2018 10:16 pm :D ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub addvalue()
    Dim NextRow As Integer
    '
    ' addvalue Macro
    '
    ' Keyboard Shortcut: Ctrl+a
    '
    Dim filePath As String, wb As Workbook
    filePath = Application.GetOpenFilename( _
        filefilter:="Excel File (*.xls*),*.xls*", _
        Title:="Open file", _
        MultiSelect:=False)
        
        If filePath = "false" Then Exit Sub
    Set wb = Workbooks.Open(filePath)
'    Windows("1.xlsm").Activate
    Range("E5:G5").Select
    Selection.Copy
    Windows("2.xlsm").Activate
    Sheets("Sheet2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "m/d/yyyy""  ""h\:mm\:ss AM/PM"
    NextRow = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1   '# To find next row
    Cells(NextRow, 1).Select
End Sub
ขอบคุณมากครับๆ ใช้ได้ผลดีครับ