Excel Forum

Code: Select all

    Sub ExpStuToCSV()
    Dim wb As Worksheet
    Dim myCSVFileName As String
    Dim myWB As Workbook
    Dim tempWB As Workbook
    Dim rngToSave As Range
    Dim FilePath As String
    Dim FPath As String
    Call MFolder2
    FPath = "C:\" & Range("A17").Value & "\"
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error GoTo err
    If MsgBox("คุณต้องการส่งออกชื่อนักเรียน ใช่หรือไม่ ?", 36, "ยืนยันการส่งออกชื่อนักเรียน") = 6 Then
    Set myWB = ThisWorkbook
    Set rngToSave = Range("C2:I1500")
    rngToSave.Copy
    Set tempWB = Application.Workbooks.Add(1)
    With tempWB
        .Sheets(1).Range("A1").PasteSpecial xlPasteValues
        .SaveAs Filename:=FPath & Sheet4.Range("A18").Value & ".csv", FileFormat:=xlCSVUTF8, CreateBackup:=False, local:=True
        .Close
                MsgBox "ส่งออกชื่อนักเรียนเรียบร้อยแล้ว.", vbInformation
      Application.ScreenUpdating = True
    End With
err:
    End If
        Application.DisplayAlerts = True
        Range("C3").Select
End Sub

Code: Select all

'Other code
With tempWB
    .Sheets(1).Range("A1").PasteSpecial xlPasteValues
    .Sheets(1).Range("a1").CurrentRegion.Resize(, 1).NumberFormat = "0"
    .Sheets(1).Range("a1").EntireColumn.AutoFit
    .SaveAs Filename:=FPath & Sheet4.Range("A18").Value & ".csv", FileFormat:=XlFileFormat.xlCSV, CreateBackup:=False, local:=True
    .Close
    MsgBox "ส่งออกชื่อนักเรียนเรียบร้อยแล้ว.", vbInformation
    Application.ScreenUpdating = True
End With
'Other code

Code: Select all

.Sheets(1).Range("a1").CurrentRegion.Resize(, 1).NumberFormat = "0"
.Sheets(1).Range("a1").EntireColumn.AutoFit