web-dev-qa-db-ja.com

VBを使用してExcelワークシートをファイル名+ワークシート名でCSVファイルに保存する

私はVBコーディングで非常に新しいです、私は複数のExcelファイルワークシートをcsvに保存しようとしています、複数のシートに対してこれを行うのはわかりませんが、私は単一のこのサイトで私がやろうとしていることに非常に役立つコードを見つけましたが、問題はファイルがワークシート名で保存されていることですが、元のファイルとfilename_worksheet nameなどのワークシート名で保存しようとしています私はそれを自分でやろうとしましたが、エラーが発生し続けています、私が間違っていることをアドバイスしてもらえますか？

私が使用しているコードは次のとおりです。

   Public Sub SaveWorksheetsAsCsv()

   Dim WS As Excel.Worksheet
   Dim SaveToDirectory As String

   Dim CurrentWorkbook As String
   Dim CurrentFormat As Long

   CurrentWorkbook = ThisWorkbook.FullName
   CurrentFormat = ThisWorkbook.FileFormat
   ' Store current details for the workbook
   SaveToDirectory = "H:\test\"
   For Each WS In ThisWorkbook.Worksheets
   WS.SaveAs SaveToDirectory & WS.Name, xlCSV
   Next

Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
'  about overwriting the original file.

End Sub
excelvbaexcel-vbacsv
25
Achak

私はこれがあなたが望むものだと思う...

Sub SaveWorksheetsAsCsv()

Dim WS As Excel.Worksheet
Dim SaveToDirectory As String

Dim CurrentWorkbook As String
Dim CurrentFormat As Long

CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "H:\test\"

For Each WS In Application.ActiveWorkbook.Worksheets
    WS.SaveAs SaveToDirectory & WS.Name, xlCSV
Next

Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
'  about overwriting the original file.

End Sub
39
Ben Strombeck

同様の問題がありました。別のCSVファイルとして保存する必要があるワークシートのデータ。

これがコマンドボタンの背後にある私のコードです

Private Sub cmdSave()
    Dim sFileName As String
    Dim WB As Workbook

    Application.DisplayAlerts = False

    sFileName = "MyFileName.csv"
    'Copy the contents of required sheet ready to paste into the new CSV
    Sheets(1).Range("A1:T85").Copy 'Define your own range

    'Open a new XLS workbook, save it as the file name
    Set WB = Workbooks.Add
    With WB
        .Title = "MyTitle"
        .Subject = "MySubject"
        .Sheets(1).Select
        ActiveSheet.Paste
        .SaveAs "MyDirectory\" & sFileName, xlCSV
        .Close
    End With

    Application.DisplayAlerts = True
End Sub

これは私のために働く:-)

7
Tudor

これはあなたがしようとしていることですか？

Option Explicit

Public Sub SaveWorksheetsAsCsv()
    Dim WS As Worksheet
    Dim SaveToDirectory As String, newName As String

    SaveToDirectory = "H:\test\"

    For Each WS In ThisWorkbook.Worksheets
        newName = GetBookName(ThisWorkbook.Name) & "_" & WS.Name
        WS.Copy
        ActiveWorkbook.SaveAs SaveToDirectory & newName, xlCSV
        ActiveWorkbook.Close Savechanges:=False
    Next
End Sub

Function GetBookName(strwb As String) As String
    GetBookName = Left(strwb, (InStrRev(strwb, ".", -1, vbTextCompare) - 1))
End Function
2
Siddharth Rout

見つけるための最善の方法は、マクロを記録して正確な手順を実行し、マクロが生成するVBAコードを確認することです。次に、汎用的にしたいビット（つまり、ファイル名など）を置き換えます

1
Bek Raupov

上記のコードは、1つの小さな欠陥で完全に機能します。結果のファイルは、拡張子.csvで保存されません。 – Tensigh 2日前

以下をコードに追加し、ファイルをcsvとして保存しました。このコードのおかげで、すべて期待どおりに機能しました。

ActiveWorkbook.SaveAs Filename:=SaveToDirectory & ThisWorkbook.Name & "-" & WS.Name & ".csv", FileFormat:=xlCSV
1
RazaJ77