2016-05-04 60 views
9

Qui ci sono molte domande per creare una macro per salvare un foglio di lavoro come file CSV. Tutte le risposte utilizzano SaveAs, come this one da SuperUser. In sostanza dicono per creare una funzione VBA come questo:Excel: macro per esportare il foglio di lavoro come file CSV senza uscire dal foglio Excel corrente

Sub SaveAsCSV() 
    ActiveWorkbook.SaveAs FileFormat:=clCSV, CreateBackup:=False 
End Sub 

questa è una grande risposta, ma voglio fare un esportazione invece di Salva con nome. Quando si esegue il SaveAs mi provoca due fastidi:

  • Il mio file di lavoro corrente diventa un file CSV. Mi piacerebbe continuare a lavorare nel mio file .xlsm originale, ma per esportare il contenuto del foglio di lavoro corrente in un file CSV con lo stesso nome.
  • Viene visualizzata una finestra di dialogo che mi chiede conferma di voler riscrivere il file CSV.

È possibile esportare il foglio di lavoro corrente come un file, ma continuare a lavorare nel mio file originale?

+2

Credo che sarebbe necessario creare una cartella di lavoro, copiare il foglio sopra, salvare come csv e chiudere la cartella di lavoro. – gtwebb

+0

@gtwebb: puoi aiutarmi? La mia conoscenza di vba è davvero rudimentale. – neves

+0

Utilizzare la seconda risposta di "SeanC" in questa domanda: http://stackoverflow.com/questions/26178913/saving-excel-worksheet-to-csv-with-file-name-from-a-cell-using-a -macro? rq = 1 –

risposta

6

Quasi ciò che volevo @Ralph. Il tuo codice ha alcuni problemi:

  1. esporta solo il foglio con hardcoded denominato "Foglio1";
  2. esporta sempre nello stesso file temporaneo, sovrascrivendolo;
  3. ignora il carattere di separazione locale.

Per risolvere questi problemi e soddisfare tutte le mie esigenze, ho adattato lo code from here. L'ho pulito un po 'per renderlo più leggibile.

Option Explicit 
Sub ExportAsCSV() 

    Dim MyFileName As String 
    Dim CurrentWB As Workbook, TempWB As Workbook 

    Set CurrentWB = ActiveWorkbook 
    ActiveWorkbook.ActiveSheet.UsedRange.Copy 

    Set TempWB = Application.Workbooks.Add(1) 
    With TempWB.Sheets(1).Range("A1") 
     .PasteSpecial xlPasteValues 
     .PasteSpecial xlPasteFormats 
    End With   

    Dim Change below to "- 4" to become compatible with .xls files 
    MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv" 

    Application.DisplayAlerts = False 
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True 
    TempWB.Close SaveChanges:=False 
    Application.DisplayAlerts = True 
End Sub 

ci sono ancora alcune piccole cose con il codice di cui sopra che si dovrebbe notare:

  1. .Close e DisplayAlerts=True dovrebbe essere in una clausola finally, ma non so come farlo in VBA
  2. Funziona solo se il nome file corrente ha 4 lettere, come .xlsm. Non funzionerebbe nei file excel .xls. Per le estensioni di file di 3 caratteri, è necessario modificare - 5 in - 4 quando si imposta MyFileName.
  3. Come effetto collaterale, gli appunti verranno sostituiti con il contenuto del foglio corrente.

Modifica: inserire Local:=True per salvare con il delimitatore CSV locale.

+1

1. 'TempWB.Close False' dovrebbe essere' TempWB.Close SaveChanges: = False', [docs] (https://msdn.microsoft.com/en-us/library/office/ff838613.aspx) 3. Cambia il '5' in' Sinistra (CurrentWB.Name, Len (CurrentWB.Name) - 5) 'lo farà funzionare con .xls [docs] (https://msdn.microsoft.com/en-us/library/ y050k1wb (v = vs.90) .aspx) Forse dovremo usare regex per rimuovere l'estensione del file ma sembra troppo lavoro per uno script throw-away – KuN

+0

@KuN: Che cosa cambia in TempWB.close? – neves

+0

Penso che sia un problema di "smarrimento nella traduzione", se si guarda nel link dei documenti che ho fornito o nella risposta di @ Raplh, vedrai che è il modo giusto per chiamare 'Workbook.Close' – KuN

12

@NathanClement è stato un po 'più veloce. Tuttavia, ecco il codice completo (leggermente più elaborato):

Option Explicit 

Public Sub ExportWorksheetAndSaveAsCSV() 

Dim wbkExport As Workbook 
Dim shtToExport As Worksheet 

Set shtToExport = ThisWorkbook.Worksheets("Sheet1")  'Sheet to export as CSV 
Set wbkExport = Application.Workbooks.Add 
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count) 
Application.DisplayAlerts = False      'Possibly overwrite without asking 
wbkExport.SaveAs Filename:="C:\tmp\test.csv", FileFormat:=xlCSV 
Application.DisplayAlerts = True 
wbkExport.Close SaveChanges:=False 

End Sub 
-1

Come ho commentato, ci sono alcuni posti su questo sito che scrivono i contenuti di un foglio di lavoro in un CSV. This one e this one per indicare solo due.

Qui di seguito è la mia versione

  • sembra esplicitamente per "" all'interno di una cella
  • Esso utilizza anche UsedRange - perché si vuole ottenere tutti i contenuti nel foglio di lavoro
  • utilizza un array per looping come questo è più veloce di loop attraverso celle del foglio
  • non ho usato le routine UST, ma questa è un'opzione

Il codice ...

Sub makeCSV(theSheet As Worksheet) 
Dim iFile As Long, myPath As String 
Dim myArr() As Variant, outStr As String 
Dim iLoop As Long, jLoop As Long 

myPath = Application.ActiveWorkbook.Path 
iFile = FreeFile 
Open myPath & "\myCSV.csv" For Output Lock Write As #iFile 

myArr = theSheet.UsedRange 
For iLoop = LBound(myArr, 1) To UBound(myArr, 1) 
    outStr = "" 
    For jLoop = LBound(myArr, 2) To UBound(myArr, 2) - 1 
     If InStr(1, myArr(iLoop, jLoop), ",") Then 
      outStr = outStr & """" & myArr(iLoop, jLoop) & """" & "," 
     Else 
      outStr = outStr & myArr(iLoop, jLoop) & "," 
     End If 
    Next jLoop 
    If InStr(1, myArr(iLoop, jLoop), ",") Then 
     outStr = outStr & """" & myArr(iLoop, UBound(myArr, 2)) & """" 
    Else 
     outStr = outStr & myArr(iLoop, UBound(myArr, 2)) 
    End If 
    Print #iFile, outStr 
Next iLoop 

Close iFile 
Erase myArr 

End Sub 
0

Come per il mio commento su @neves post, ho un po 'migliorato questo aggiungendo le xlPasteFormats così come i valori parte in modo date vanno attraverso come date - Io per lo più Salva come CSV per la banca dichiarazioni, quindi date necessarie.

`Sub ExportAsCSV()

Dim MyFileName As String 
Dim CurrentWB As Workbook, TempWB As Workbook 

Set CurrentWB = ActiveWorkbook 
ActiveWorkbook.ActiveSheet.UsedRange.Copy 

Set TempWB = Application.Workbooks.Add(1) 
With TempWB.Sheets(1).Range("A1") 
    .PasteSpecial xlPasteValues 
    .PasteSpecial xlPasteFormats 
End With 

'Dim Change below to "- 4" to become compatible with .xls files 
MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv" 

Application.DisplayAlerts = False 
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True 
TempWB.Close SaveChanges:=False 
Application.DisplayAlerts = True 

Fine Sub`

+0

Lo adorerei come un componente aggiuntivo, qualcuno ha avuto il tempo di farlo accadere? –

Problemi correlati