Macro : Export file to Excel แล้วไม่มี File

[wisitsakbenz]

เรียน สอบถามอาจารย์ครับ

1. File นี้คือตัวอย่างนะครับ File จริงมีขนาดใหญ่ เลยยกตัวอย่างไฟล์นี้ครับ
ผมต้องการ Export file to Excel แล้วไม่มี File ไม่แน่ใจว่าต้องปรับ Code ตรงไหนหรือไม่ครับ ขอบคุณครับ
2. ถ้า Sheet "Forms" ที่ต้องการ Export มีการดึงสูตรจาก Sheet "Input" หลังจาก Export แล้ว สูตรจะไปด้วยหรือไม่ครับ

Code: Select all

Private Sub CommandButton1_Click()
Worksheets("Data").Activate

'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")


'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for saving file
strFile = Sheets("Input").Range("E6").Value & "_" & Sheets("Input").Range("E7").Value & "_" & Sheets("Input").Range("E12").Value & ".xls"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="Excel Files (*.xls), *.xls", _
        Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
    'wsA.ExportAsFixedFormat
    'Copy the ActiveSheet to new workbook
            For Each wsA In ActiveWorkbook.Worksheets
                    wsA.UsedRange.Copy
                    wsA.UsedRange.PasteSpecial Paste:=xlPasteValues
            Application.CutCopyMode = False
   Next

    'confirmation message with file info
    MsgBox "Excel  file has been created: " _
      & vbCrLf _
      & myFile
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create Excel file"
    Resume exitHandler

End Sub

[snasui]

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

Code: Select all

myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="Excel Files (*.xls), *.xls", _
        Title:="Select Folder and FileName to save")
ActiveWorkbook.SaveAs Filename:=myFile, FileFormat:=XlFileFormat.xlExcel12

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

[wisitsakbenz]

เรียน snasui อาจารย์ครับ

ผมอยากให้ export Sheet โดย Copy Sheet "Data" แล้วสร้าง Worksheet ใหม่โดยตั้งชื่อตาม ค่าของ E6-E8 ใน Sheet "Input"
และไม่มี มาโครติดไปด้วย ต้องปรับ Code อย่างไรบ้างครับ ขอบคุณครับ

[puriwutpokin]

ลองปรับเป็นโค้ดนี้ดูครับ

Code: Select all

Dim aName, myFile As Range
Dim fldr As FileDialog
Dim selectedFolder As String
Application.DisplayAlerts = False
Set aName = Sheets("Input").Range("e6:e8")
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .Show
        selectedFolder = .SelectedItems(1)
    End With
For Each myFile In aName
    Sheets("Data").Copy
    ActiveWorkbook.SaveAs Filename:=selectedFolder & "\" & myFile & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close
Next myFile
Application.DisplayAlerts = True

[wisitsakbenz]

เรียน อาจารย์ puriwutpokin

จากการทำลอง run แล้วไม่ได้ครับ > จะให้หา Folder ที่จะ save แล้ว หลังจากนั้นใส่ชื่อ > กด open แล้ว error ดังไฟล์แนบครับ
ขอบคุณครับ

[puriwutpokin]

ไม่ต้องใส่ชื่อไฟล์ครับ​ ให้เลือกโฟลเดอร์​ที่จะเซฟพอครับ

[wisitsakbenz]

ต้องการให้ได้แค่ไฟล์เดียว และไม่มีปุ่ม Exportexcel ครับ โดยชื่อไฟล์คือ Thai_Nong_EN
ของอาจารย์ puriwutpokin แยกเป็น 3 ไฟล์ 3 ชื่อ
รบกวนด้วยครับ ขอบคุณครับ

[puriwutpokin]

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

Code: Select all

Application.DisplayAlerts = False
Sheets("Data").Copy
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="Excel Files (*.xlsx), *.xlsx", _
        Title:="Select Folder and FileName to save")
ActiveWorkbook.SaveAs Filename:=myFile, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True

[wisitsakbenz]

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