save ไฟล์ backup

[mr.zatan]

ต้องการให้เมื่อเราเซฟไฟล์งาน.
1. ให้เซฟอีกไฟล์นึงไว้อัตโนมัติ
2. และบันทึกตั้งแต่ Row ที่ 3 เป็นตั้นไป

รบกวนด้วยครับ.

Code: Select all

Sub SaveCopyAs()
ActiveWorkbook.SaveCopyAs "C:\Users\servers\Desktop\Print\backup.xlsm"
End Sub

[snasui]

ตัวอย่างการบันทึกไปเป็นอีกไฟล์หนึ่งอัตโนมัติดูตาม Link นี้ครับ http://snasui.com/viewtopic.php?p=107312#p107315

ส่วนการบันทึกตั้งแต่บรรทัดนั้นบรรทัดนี้คงต้องเขียน Code เก็บค่าบรรทัดอื่นเอาไว้ที่อื่นก่อน เช่นเก็บไว้ในชีตอื่น ไฟล์อื่น เมื่อ Save ไปเป็นไฟล์สำรองแล้วค่อยนำค่านั้นกลับมาวางใหม่ ฯลฯ

[mr.zatan]

ก็ยังไม่ save ให้เองอยู่ดีครับ ต้องกด run ถึงจะทำงาน

Code: 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

[snasui]

คำว่า Save ให้เองมันจะต้องมีเหตุการณ์ (Event) ที่จะใช้ตรวจสอบเพื่อให้ Code ทำงานเมื่อเกิดเหตุการณ์นั้น เช่นการเลือกเซลล์ การเปลี่ยนค่าในเซลล์ การเลือกชีต การ Save การปิดไฟล์ ฯลฯ ไม่ทราบว่าต้องการให้ Save Backup เองในจังหวะไหนหรือเกิดเหตุการณ์ใดครับ

[mr.zatan]

คำว่า Save ให้เองมันจะต้องมีเหตุการณ์ (Event) ที่จะใช้ตรวจสอบเพื่อให้ Code ทำงานเมื่อเกิดเหตุการณ์นั้น เช่นการเลือกเซลล์ การเปลี่ยนค่าในเซลล์ การเลือกชีต การ Save การปิดไฟล์ ฯลฯ ไม่ทราบว่าต้องการให้ Save Backup เองในจังหวะไหนหรือเกิดเหตุการณ์ใดครับ

save backup ตอนกด save ไฟล์ครับ (อันนี้ืทำได้แล้วครับ) เหลือแต่เรื่อง save row ครับ

[snasui]

ไม่เข้าใจคำว่า Save Row ช่วยทำไฟล์ตัวอย่างพร้อมแสดงให้เห็นว่าเดิมเป็นแบบไหน และต้องการให้แสดงผลลัพธ์เป็นแบบไหน ถ้าเป็นไปตามที่ผมเขียนแนะนำไว้แล้วจะต้องเขียน Code มาก่อน ติดตรงไหนค่อยนำมาถามกันต่อครับ

[mr.zatan]

code นี้น่าจะใกล้เคียง

ต้องการลบ row ที่ A1 , A2 (2 แถวบนสุดนั้นแหละครับ)

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

[snasui]

ตัวอย่างการลบ 2 บรรทัดแรกครับ

Code: Select all

'Other code
With ActiveWorkbook
    Sheets(1).Range("a1:a2").EntireRow.Delete shift:=xlUp
'Other code

[mr.zatan]

ขอบคุณครับ

พอดีว่าผมจะเอาไป import ใส่ mysql เลยจะลบบรรทัดที่ไม่จำเป็นออก

[mr.zatan]

ตัวอย่างการลบ 2 บรรทัดแรกครับ

Code: Select all

'Other code
With ActiveWorkbook
    Sheets(1).Range("a1:a2").EntireRow.Delete shift:=xlUp
'Other code

Sheets(1) อันนี้ใช่ชื่อ sheet ไหมครับ เพราะผมลองเปลี่ยนเป็นชื่อ worksheet ที่ต้องการแล้ว error

[logic]

เลข 1 เป็นเลขลำดับของชีต sheets(1) ก็คือชีตลำดับที่ 1 ครับ

[mr.zatan]

ถ้าต้องการระบุชื่อ sheet สามารถทำได้ไหมครับ

[logic]

ใส่ชื่อชีตแทนเลข 1 เข้าไปเลยครับ ตัวอย่าง Sheets("xyz") อะไรแบบนี้ครับ

[mr.zatan]

ขอบคุณครับ

เจออีกปัญหาครับ

- ถ้ามีมากกว่า 1 sheet เกิด error

Run-time error '9':
subscript out of range

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

[logic]

ใช้โค้ดวนลูปให้คัดลอกชีตไปสร้างเป็นไฟล์ใหม่ แต่ละชีตชื่อไม่เหมือนกันแต่ไปใส่ให้มันเป็นชื่อเดิม ๆ ก็เกิด Error อยู่แล้วครับ

เวลาคัดลอกชีตไปใช้ มันก็เป็นชีตแรกของไฟล์ใหม่ สังเกตว่าอาจารย์ใช้เป็น Sheets(1) มันคือชีตที่ 1 ของไฟล์ใหม่ และมันก็ง่ายดีอยู่แล้ว ไม่ต้องไปสนใจว่าชื่ออะไร เขียนแบบนี้แล้วมัน Error แบบไหนหรือครับ

[mr.zatan]

ผมต้องการแค่ sheet ("MT") ครับ sheet อื่นๆๆไม่ต้อง copy

[snasui]

ต้องการแค่ชีต 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

[mr.zatan]

sheet อื่นๆๆเด้งมาเต็ม Taskbar เลยครับ

[snasui]

ผมทดสอบแล้วไม่พบปัญหาใด กรุณาแนบไฟล์ล่าสุดพร้อมแสดงให้เห็นว่าเกิดปัญหาตรงไหน อย่างไร เพื่อนสมาชิกจะได้ช่วยดูให้ได้ครับ

[mr.zatan]

ได้แล้วครับ ขอบคุณครับ