ฟอรัม Excel, VBA และอื่นๆ ของคนไทยเพื่อประโยชน์ของทุกคนในจักรวาล (Forum Excel, VBA and others of Thai people for everyone in the universe.)
https://snasui.com/
Code: Select all
Sub SaveCopyAs()
ActiveWorkbook.SaveCopyAs "C:\Users\servers\Desktop\Print\backup.xlsm"
End Sub
ตัวอย่างการบันทึกไปเป็นอีกไฟล์หนึ่งอัตโนมัติดูตาม Link นี้ครับ http://snasui.com/viewtopic.php?p=107312#p107315Code: Select all
Sub SaveBackup()
Dim D As String, FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
D = "backup.xlsm"
ActiveWorkbook.Save
FSO.CopyFile ActiveWorkbook.FullName, "C:\Users\servers\Desktop\Print\" & D
End Sub
save backup ตอนกด save ไฟล์ครับ (อันนี้ืทำได้แล้วครับ) เหลือแต่เรื่อง save row ครับ
ไม่เข้าใจคำว่า Save Row ช่วยทำไฟล์ตัวอย่างพร้อมแสดงให้เห็นว่าเดิมเป็นแบบไหน และต้องการให้แสดงผลลัพธ์เป็นแบบไหน ถ้าเป็นไปตามที่ผมเขียนแนะนำไว้แล้วจะต้องเขียน Code มาก่อน ติดตรงไหนค่อยนำมาถามกันต่อครับCode: Select all
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet, SaveToDirectory As String
SaveToDirectory = "C:\Users\servers\Desktop\Print\"
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
ws.Copy
With ActiveWorkbook
.Sheets(1).Cells(1).EntireRow.Delete shift:=xlUp
.SaveAs Filename:=SaveToDirectory & .Sheets(1).Name & ".csv", FileFormat:=xlCSVMSDOS, CreateBackup:=False
.Close SaveChanges:=True
End With
Next ws
Application.DisplayAlerts = True
End Sub
Code: Select all
'Other code
With ActiveWorkbook
Sheets(1).Range("a1:a2").EntireRow.Delete shift:=xlUp
'Other code
Sheets(1) อันนี้ใช่ชื่อ sheet ไหมครับ เพราะผมลองเปลี่ยนเป็นชื่อ worksheet ที่ต้องการแล้ว errorsnasui wrote: ↑Sun Aug 15, 2021 8:08 pm
Code: Select all
'Other code With ActiveWorkbook Sheets(1).Range("a1:a2").EntireRow.Delete shift:=xlUp 'Other code
sheets(1) ก็คือชีตลำดับที่ 1 ครับSheets("xyz") อะไรแบบนี้ครับCode: Select all
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet, SaveToDirectory As String
SaveToDirectory = "C:\Users\servers\Desktop\Print\"
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
ws.Copy
With ActiveWorkbook
.Sheets("MT").Range("a1:a2").EntireRow.Delete shift:=xlUp
.SaveAs Filename:=SaveToDirectory & .Sheets("MT").Name & ".csv", FileFormat:=xlCSVMSDOS, CreateBackup:=False
.Close SaveChanges:=True
End With
Next ws
Application.DisplayAlerts = True
End Sub
Sheets(1) มันคือชีตที่ 1 ของไฟล์ใหม่ และมันก็ง่ายดีอยู่แล้ว ไม่ต้องไปสนใจว่าชื่ออะไร เขียนแบบนี้แล้วมัน Error แบบไหนหรือครับ 
ต้องการแค่ชีต MT สามารถปรับ Code เป็นด้านล่างครับCode: Select all
'Other code
' For Each ws In ThisWorkbook.Worksheets
' ws.Copy
ThisWorkbook.Worksheets("MT").Copy
With ActiveWorkbook
.Sheets("MT").Range("a1:a2").EntireRow.Delete shift:=xlUp
.SaveAs Filename:=SaveToDirectory & .Sheets("MT").Name & ".csv", FileFormat:=xlCSVMSDOS, CreateBackup:=False
.Close SaveChanges:=True
End With
' Next ws
'Other code