ต้องการเขียนคำสั่งให้ save ชื่อตาม เซลล์ O4

[widtara]

สวัสดีค่ะ จากการที่อ้อยเคยเขียนคำสั่ง vba จากไฟล์ .xlsm ให้แยกชีทได้ครั้งเดียวด้วย code
เขียนใน
Sub Macro1()
Dim i As Integer
For i = 1 To Workbooks("sheet.xlsm").Worksheets.Count
Workbooks("sheet.xlsm").Worksheets(i).Copy
Next i
End Sub

ต่อมาต้องการให้ชีทที่แยกออกมามีชื่อตาม เซลล์ O4
ต้องเขียน code ยังงัยเพิ่มค่ะ

[snasui]

หลังจาก Copy แล้ว ลองเพิ่มบรรทัดนี้เข้าไปครับ

Code: Select all

Activesheet.Name = Range("O4").Value

[widtara]

ขอบคุณค่ะ สำหรับคำตอบสามารถทำได้คือเมื่อแยกชีทแล้วชื่อในช่อง O4 จะเป็นชื่อ sheet
แต่ว่าคำถามนี้อาจจะใช้คำไม่ค่อยเข้าใจค่ะ แต่คำตอบก็ดีมาก อยากถามเพิ่มต่อไปว่า
หากต้องการกำหนดให้ชื่อไฟล์ ที่แยกออกตามมีชื่อตาม ช่อง O4 ค่ะ เป็นชื่อไฟล์นะค่ะ เพราะอ้อยอยากจะกด save เลย เมื่อมันแยกออกแล้วเพราะ
ปัจจุบันอ้อยต้องมาเปลี่ยนชื่อไฟล์ เช่น จาก book 1 เป็นชื่อไฟล์ตามช่อง O4 ค่ะ ช่วยหน่อยนะค่ะ ขอบคุณค่ะ

[snasui]

Code สำหรับการบันทึกคือ

ActiveWorkbook.SaveAs Filename:="YourPath\xxx.xls"

โดย YourPath คือ Path ที่ต้องการเก็บไฟล์ ,xxx.xls คือชื่อไฟล์

หากเมื่อเราต้องการจะ Save เป็นชื่อที่เรากำหนดไว้ในเซลล์ใด ๆ ใน Drive D: สามารถแก้ไขเป็น

ActiveWorkbook.SaveAs Filename:="D:\" & ActiveSheet.Range("O4").Value &".xls"

[widtara]

ที่อยู่ที่ต้องการนำไปเก็บค่ะ
C:\Documents and Settings\supitsara.p\My Documents\NCR
จึงเขียนออกมาเป็น
Sub Macro1()
Dim i As Integer
For i = 1 To Workbooks("1.xlsm").Worksheets.Count
Workbooks("1.xlsm").Worksheets(i).Copy
ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\supitsara.p\My Documents\NCR" & ActiveSheet.Range("O4").Value &.xls"
Activesheet.Name = Range("O4").Value
Next i
End Sub

แต่ error ค่ะ
ที่บริษัทใช้ D:\ ไม่ได้ ต้องเป็น C:\ หรือ ไดร์แชร์กันค่ะ ก็เลขตั้ง Folder ชื่อ NCR ไว้รองรับค่ะ
ช่วยดูให้หน่อยค่ะ

[snasui]

ถ้าต้องเปลี่ยนชื่อชีทก่อนให้เขียน Code ที่เป็นชื่อชีทไว้ก่อนครับ เป็น

Code: Select all

Sub Macro1()
Dim i As Integer
For i = 1 To Workbooks("1.xlsm").Worksheets.Count
 Workbooks("1.xlsm").Worksheets(i).Copy
Activesheet.Name = Range("O4").Value
ActiveWorkbook.SaveAs Filename:="C:\Documents and Settings\supitsara.p\My Documents\NCR" & ActiveSheet.Range("O4").Value &".xls"
Next i
End Sub

เนื่องจาก Code ด้านบนผมคีย์ตกไปต้องเปลี่ยน &.xls" เป็น &".xls"

[widtara]

แต่เวลาเปิดไฟล์แล้วจะมีคำถามก่อนค่ะ คือให้ตอบ yes หรือ no ถ้าตอบ yes ถึงเปิดได้ ถ้าตอบ no เปิดไม่ได้ อยากสอบถามอาจารย์เพิ่มเติมว่า เราสามารถที่จะเปิดโดยที่ไม่มี กล่องมาถามแบบนี้ได้ไหมค่ะ เพราะว่ามีคนมาใช้ไฟล์หลายคน เขาอาจจะไม่กล้าเปิดเพราะคิดว่าไฟล์อาจมีปัญหาค่ะ รบกวนหน่อยนะค่ะ ขอบคุณค่ะ

อีกอย่างไฟล์ไม่วิ่งเข้าใน Folders NCR ด้วยค่ะ

[snasui]

อีกอย่างไฟล์ไม่วิ่งเข้าใน Folders NCR ด้วยค่ะ

ใน Code หลัง NCR ต้องมี \ เป็น NCR\ ครับ
ส่วนที่โปรแกรมฟ้องเช่นนั้นยังไม่ทราบสาเหตุครับ เพราะว่านามสกุลไฟล์ก็เป็น .xls ซึ่งถูกต้องแล้ว ลองสร้างไฟล์ Excel อื่น ๆ และเก็บใน Folder เดียวกันแล้วลองเปิด สังเกตว่าเป็นเหมือนกันหรือไม่ครับ

[widtara]

ได้แล้วค่ะ อาจารย์ อ้อยใช้แบบนี้ค่ะ
Sub Macro1()
Dim i As Integer
For i = 1 To ThisWorkbook.Worksheets.Count
ThisWorkbook.Worksheets(i).Copy
'ActiveSheet.Name = Workbooks("sheet.xlsm").Sheets(i).Range("O4").Value
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Range("O4").Value & Range("j13").Value & ".xls", FileFormat:=xlExcel8, CreateBackup:=False
ActiveWorkbook.Close True
Next i
End Sub

ผลลัพธ์ดีมาก เขาจะ save ให้ด้วยชื่อไฟล์ที่ต้องการ แก้ไขชื่อ sheet ให้ด้วย และ save เป็น 2003 และ save ลง folders
ที่เราวางไฟล์ไว้เลย แล้วก็ปิดไฟล์ให้อัตโนมัติค่ะ ไม่ต้องมาคอยปิด และปิดไฟล์ได้ดีไม่มีปัญหาค่ะ

[snasui]

ยินดีด้วยครับ ผมเดาว่าสาเหตุเกิดจากไฟล์เดิมมีนามสกุลเป็น .xlsm แล้วต้องการ Save เป็น .xls ทำให้ Default ของ FileFormat เปลี่ยนไป เราสามารถกำหนด FileFormat เป็นตามด้านล่างเพื่อให้เป็น Excel ธรรมดาได้ครับ

FileFormat:=xlNormal