Save ไฟล์ ด้วย VBA

[babyminds]

อยากให้ไฟล์ที่เซฟด้วย VBA เป็นไฟล์ที่ไม่มีสูตร และไม่มีปุ่ม Save

Code: Select all

    ActiveWorkbook.SaveAs Filename:= _
        "D:\Users\saartorn\Desktop\" & Range("f1").Value & ".xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

ไฟล์ที่เซฟมาใหม่มันมีสูตรติดมาด้วย อยากไห้เคลียสูตรเป็น Value และลบปุ่ม Save ออกด้วยครับ

Book1.xlsb

(15.59 KiB) Downloaded 10 times

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub SaveXYZ()
    With Worksheets("Transfer")
        .Shapes("Button 1").Delete
        .Range("a1").CurrentRegion.Value = .Range("a1").CurrentRegion.Value
    End With
    ActiveWorkbook.SaveAs Filename:= _
        "D:\Users\saartorn\Desktop\" & Range("f1").Value & ".xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

การเขียน Code ควรตั้งชื่อคำสั่งให้เป็นชื่ออื่น พยายายามอย่าให้ซ้ำกับคำสั่งของ Excel อย่าตั้งเป็นเช่น Save, Delete, Select อะไรพวกนี้เป็นต้นครับ

[babyminds]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub SaveXYZ()
    With Worksheets("Transfer")
        .Shapes("Button 1").Delete
        .Range("a1").CurrentRegion.Value = .Range("a1").CurrentRegion.Value
    End With
    ActiveWorkbook.SaveAs Filename:= _
        "D:\Users\saartorn\Desktop\" & Range("f1").Value & ".xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

การเขียน Code ควรตั้งชื่อคำสั่งให้เป็นชื่ออื่น พยายายามอย่าให้ซ้ำกับคำสั่งของ Excel อย่าตั้งเป็นเช่น Save, Delete, Select อะไรพวกนี้เป็นต้นครับ

แล้วไฟล์ที่เซฟ ให้เป็นไฟล์ xlsx. เลยได้ไหมครับ

[snasui]

Excel สามารถ Save ได้หลายรูปแบบ หากต้องการ Save เป็น .xlsx สามารถเปลี่ยน xlOpenXMLWorkbookMacroEnabled เป็น xlOpenXMLWorkbook ดูตารางนี้ประกอบครับ XlFileFormat enumeration

[babyminds]

Excel สามารถ Save ได้หลายรูปแบบ หากต้องการ Save เป็น .xlsx สามารถเปลี่ยน xlOpenXMLWorkbookMacroEnabled เป็น xlOpenXMLWorkbook ดูตารางนี้ประกอบครับ XlFileFormat enumeration

เพิ่มเติมหน่อยครับ ไฟล์ที่ Save สามารถไห้มันลบ Row ที่ไม่เกิดข้อความด้วยได้ไหมครับ เช่น ตาราง มี 10 แถว แต่คียไปแค่ 5 รายการ ไห้มันลบแถวที่เหลือ และคอลัมน์อ้างอิง 1 คอลัมน์ คือคอลัมน์ E

[snasui]

สามารถทำได้ ลองเขียนมาเองก่อนตามกฎการใช้บอร์ดข้อ 5 ด้านบน ติดตรงไหนค่อยนำไฟล์นั้นมาถามกันต่อครับ

[babyminds]

สามารถทำได้ ลองเขียนมาเองก่อนตามกฎการใช้บอร์ดข้อ 5 ด้านบน ติดตรงไหนค่อยนำไฟล์นั้นมาถามกันต่อครับ

Code: Select all

Sub SaveXYZ()
            Rows("4:8").Select
    Selection.Delete Shift:=xlUp
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    With Worksheets("Transfer")
        .Shapes("Button 1").Delete
        .Range("a1").CurrentRegion.Value = .Range("a1").CurrentRegion.Value
    End With
    ActiveWorkbook.SaveAs Filename:= _
        "D:\Users\saartorn\Desktop\" & Range("f1").Value & ".xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

มัน ERROR อ่ะครับ

[snasui]

กรุณาแนบไฟล์ล่าสุดมาด้วยจะได้ตอบต่อไปจากนั้นครับ

[babyminds]

กรุณาแนบไฟล์ล่าสุดมาด้วยจะได้ตอบต่อไปจากนั้นครับ

Book1.xlsb

(16.93 KiB) Downloaded 10 times

นี่ครับ

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

With Worksheets("Transfer")
    .Range("b" & .Rows.Count).End(xlUp) _
        .Offset(1, 0).Resize(1000).EntireRow.Delete
    .Range("e1").EntireColumn.Delete
    .Shapes("Button 1").Delete
    .Range("a1").CurrentRegion.Value = .Range("a1").CurrentRegion.Value
End With

ค่าที่ให้ Save เป็น .xlsx ผมตอบไปแล้วตามด้านบน ในไฟล์ที่ส่งมายังไม่ได้ Update ต้อง Update ด้วยครับ

[babyminds]

ตัวอย่างการปรับ Code ครับ

Code: Select all

With Worksheets("Transfer")
    .Range("b" & .Rows.Count).End(xlUp) _
        .Offset(1, 0).Resize(1000).EntireRow.Delete
    .Range("e1").EntireColumn.Delete
    .Shapes("Button 1").Delete
    .Range("a1").CurrentRegion.Value = .Range("a1").CurrentRegion.Value
End With

ค่าที่ให้ Save เป็น .xlsx ผมตอบไปแล้วตามด้านบน ในไฟล์ที่ส่งมายังไม่ได้ Update ต้อง Update ด้วยครับ

อันนี้ต้องเอา Code ไปต่อรวมกับ Code แรกไหมครับ

[babyminds]

ตัวอย่างการปรับ Code ครับ

Code: Select all

With Worksheets("Transfer")
    .Range("b" & .Rows.Count).End(xlUp) _
        .Offset(1, 0).Resize(1000).EntireRow.Delete
    .Range("e1").EntireColumn.Delete
    .Shapes("Button 1").Delete
    .Range("a1").CurrentRegion.Value = .Range("a1").CurrentRegion.Value
End With

ค่าที่ให้ Save เป็น .xlsx ผมตอบไปแล้วตามด้านบน ในไฟล์ที่ส่งมายังไม่ได้ Update ต้อง Update ด้วยครับ

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

[babyminds]

ตัวอย่างการปรับ Code ครับ

Code: Select all

With Worksheets("Transfer")
    .Range("b" & .Rows.Count).End(xlUp) _
        .Offset(1, 0).Resize(1000).EntireRow.Delete
    .Range("e1").EntireColumn.Delete
    .Shapes("Button 1").Delete
    .Range("a1").CurrentRegion.Value = .Range("a1").CurrentRegion.Value
End With

ค่าที่ให้ Save เป็น .xlsx ผมตอบไปแล้วตามด้านบน ในไฟล์ที่ส่งมายังไม่ได้ Update ต้อง Update ด้วยครับ

อาจารย์ครับเพิ่มเติมนิดนึงครับ ถ้าต้องการไห้มัน Delete Row ลงมาแค่ถึง Total ได้ไหมครับ อันนี้ใส่ Total แล้ว Save มันโดนลบไปด้วย

Book1.xlsm

(18.78 KiB) Downloaded 5 times

[snasui]

กรุณาเขียนมาเองก่อน แนบไฟล์ทีได้ปรับปรุง Code นั้นมาแล้วด้วย จะได้ตอบต่อไปจากนั้น ทุกคำถามเกี่ยวกับ VBA กรุณาทำมาเองก่อนทุกครั้งครับ

[babyminds]

กรุณาเขียนมาเองก่อน แนบไฟล์ทีได้ปรับปรุง Code นั้นมาแล้วด้วย จะได้ตอบต่อไปจากนั้น ทุกคำถามเกี่ยวกับ VBA กรุณาทำมาเองก่อนทุกครั้งครับ

Code: Select all

Sub SaveXYZ()
With Worksheets("Transfer")
    .Range("b" & .Rows.Count).End(xlUp) _
        .Offset(1, 0).Resize(1000).EntireRow.Delete
    .Range("h1").EntireColumn.Delete
    .Shapes("Button 1").Delete
    .Range("a1").CurrentRegion.Value = .Range("a1").CurrentRegion.Value
End With
    ActiveWorkbook.SaveAs Filename:= _
        "D:\Users\saartorn\Desktop\" & Range("f1").Value & ".xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

Book1.xlsm

(18.78 KiB) Downloaded 11 times

นี่ครับ

[puriwutpokin]

ลองปรับตามนี้ดูครับ

Code: Select all

Sub SaveXYZ()
With Worksheets("Transfer")
Set Rng = ActiveSheet.UsedRange
Col = 2
For i = Rng.Rows.Count To 1 Step -1
If Rng.Cells(i, Col) = "" And Rng.Cells(i, Col - 1) <> "TOTAL" Then
Rng.Cells(i, Col).EntireRow.Delete
End If
Next i
    .Range("h1").EntireColumn.Delete
    .Shapes("Button 1").Delete
    .Range("a1").CurrentRegion.Value = .Range("a1").CurrentRegion.Value
End With
    ActiveWorkbook.SaveAs Filename:= _
        "D:\Users\saartorn\Desktop\" & Range("f1").Value & ".xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub