web-dev-qa-db-ja.com

Excel：現在のExcelシートを離れずにワークシートをCSVファイルとしてエクスポートするマクロ

ここには、ワークシートをCSVファイルとして保存するマクロを作成するための多くの質問があります。すべての回答では、SuperUserの this one のようなSaveAsを使用します。彼らは基本的にこのようなVBA関数を作成すると言います：

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

これは素晴らしい答えですが、名前を付けて保存の代わりにエクスポートを実行したいと思います。 SaveAsを実行すると、次の2つの面倒が生じます。

  • 現在の作業ファイルはCSVファイルになります。元の.xlsmファイルで作業を続けたいが、現在のワークシートの内容を同じ名前のCSVファイルにエクスポートしたい。
  • CSVファイルの書き換えを確認するダイアログが表示されます。

現在のワークシートをファイルとしてエクスポートするだけで、元のファイルで作業を続けることは可能ですか？

excelvbaexcel-vbacsvexport-to-csv
22
neves

@Ralphがほしかったもの。あなたのコードにはいくつかの問題があります：

  1. 「Sheet1」という名前のハードコーディングされたシートのみをエクスポートします。
  2. 常に同じ一時ファイルにエクスポートして上書きします。
  3. ロケール分離文字を無視します。

これらの問題を解決し、すべての要件を満たすために、 ここからのコード を採用しました。読みやすくするために少し整理しました。

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

上記のコードには、まだ気づかなければならない小さなことがいくつかあります。

  1. .CloseとDisplayAlerts=Trueはfinally節に含める必要がありますが、VBAでそれを行う方法がわかりません
  2. 現在のファイル名が.xlsmのように4文字の場合にのみ機能します。 .xls Excelファイルでは機能しません。 3文字のファイル拡張子の場合、MyFileNameを設定するときに- 5を- 4に変更する必要があります。
  3. 付随的な効果として、クリップボードは現在のシートの内容に置き換えられます。

編集：Local:=Trueを入力して、ロケールCSV区切り文字で保存します。

11
neves

@NathanClementは少し高速でした。ただし、完全なコードは次のとおりです（少し複雑です）。

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
22
Ralph

@nevesの投稿に対する私のコメントの通り、xlPasteFormatsと値の部分を追加することでこれをわずかに改善し、日付が日付として渡されるようにしました。

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
0
Craig Lambie