2015-11-28 3 views
1

Я хочу экспортировать в CSV, а не «Сохранить как», поэтому создайте кнопку, которая будет включена макросом. При нажатии на нее должен быть создан CSV-файл первого листа в указанном каталоге, а также указанное имя. И мой первоначальный рабочий лист должен быть сохранен и не сохранен как.Экспорт в CSV

+0

Почему бы не сделать сохранить копию как CSV? –

+0

Saveas csv преобразует только один лист в csv – Davesexcel

+0

@Davesexcel OP говорит только о одном листе и на самом деле не дает никаких оснований для желания изобретать это колесо. –

ответ

2

Если у вас нет запятых, встроенные в клетки, это может быть достаточно:

Sub CSV_Maker() 
    Dim r As Range 
    Dim sOut As String, k As Long, M As Long 
    Dim N As Long, nFirstRow As Long, nLastRow As Long 

    Sheets(1).Select 

    ActiveSheet.UsedRange 
    Set r = ActiveSheet.UsedRange 
    nLastRow = r.Rows.Count + r.Row - 1 
    nFirstRow = r.Row 
    Dim separator As String 
    separator = "," 

    MyFilePath = "C:\TestFolder\" 
    MyFileName = "whatever" 
    Set fs = CreateObject("Scripting.FileSystemObject") 
    Set a = fs.CreateTextFile(MyFilePath & MyFileName & ".csv", True) 

    For N = nFirstRow To nLastRow 
     k = Application.WorksheetFunction.CountA(Cells(N, 1).EntireRow) 
     sOut = "" 
     If k = 0 Then 
      sOut = vbCrLf 
     Else 
      M = Cells(N, Columns.Count).End(xlToLeft).Column 
      For mm = 1 To M 
       sOut = sOut & Cells(N, mm).Value & separator 
      Next mm 
      sOut = Left(sOut, Len(sOut) - 1) 
     End If 
     a.writeline (sOut) 
    Next 

    a.Close 
End Sub 
+0

Это помогает спариться. Но тот, о котором упоминал ** Фред ** выше, простенький. – aneeshjajodia

3

Если точка сохранить оригинальную книгу нетронутыми, то почему бы не получить творческий. Мы можем скопировать лист в другую книгу и сохранить в формате .csv

Option Explicit 

Sub ExportOneSheet() 

    Const strFILE_NAME As String = "C:\Users\Tom\Desktop\tes.csv" 

    Dim shToExport As Worksheet 

    ' Set the sheet to copy 
    Set shToExport = ActiveWorkbook.Sheets("Sheet1") 

    ' Make a copy of the sheet, when called without argument 
    ' it will create a new workbook 
    shToExport.Copy 
    Set shToExport = ActiveWorkbook.Sheets("Sheet1") 

    ' If the file exists the delete it. This will esure that 
    ' there is no previous file so the replace file thing will not show 
    If Not Dir$(strFILE_NAME, vbNormal) = vbNullString Then 
     Kill strFILE_NAME 
    End If 

    ' Use Save As and your original workbook stays untouched. 
    shToExport.SaveAs strFILE_NAME, XlFileFormat.xlCSV 
    shToExport.Parent.Close True 

End Sub 

Я надеюсь, что это помогает :)

+0

Позвольте мне попробовать это, вернемся к вам, если это сработает. – aneeshjajodia

+0

Ну, это прекрасно работает, как и предполагалось. **Большое спасибо**. Был бы еще более рад, если бы был способ пропустить кнопки * Да * или * Нет * для ** Замена существующего ** файла. Может быть, все пройдет, верно? – aneeshjajodia

+0

Я изменил ответ, чтобы удалить файл, он уже есть. Поэтому теперь вам не будет предложено заменить файл. –