Excelで選択範囲のみをダブルコーテーション付きでCSVファイル保存するVBAマクロ

背景

たまにExcelの一部データをCSVファイルにする事があったのですが、
そんなに頻繁ではなかったのでSAKURAエディタで貼り付けて→タブ置換からのCSV保存をしていたのですが、
定期的に行っているなって気づいたのでマクロ化しようとなりました。

作成したい機能

エクセルで選択した範囲の値をCSVファイル化したい

CSV形式

項目	値
区切り文字	,(カンマ)
ダブルコーテーション	あり
文字コード	SJIS
改行コード	CRLF

ついでに名前を付けて保存

最初

Excel選択範囲をCSVファイル保存するだけなら、そんなにめんどくさくない
下記の参考サイト様よりちょっと改造
参考：https://excel-excel.com/tips/vba_198.html

Option Explicit

Sub csv_create_0()
    Dim sname, fname As String
    Dim rng As String

    'CSVファイル名
    fname = Application.GetSaveAsFilename(, "CSVファイル(*.csv),*.csv")

    '選択範囲のセルアドレス
    rng = Selection.Address
    'シート名
    sname = ActiveSheet.Name
    '新しいシートを追加し、選択範囲を値コピー
    Range(rng).Copy
    Worksheets.Add.Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False

    '新しいブックを作成し、そこにシートを移動する
    ActiveSheet.Move
    '上書きのメッセージを表示させない
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=fname, FileFormat:=xlCSV
    '仮Excelは保存せずに閉じる
    ActiveWorkbook.Close savechanges:=False
    'メッセージ表示を戻す
    Application.DisplayAlerts = True
End Sub

ただ、上記マクロだとダブルコーテーションが付与できない。。。
replaceを使った正規表現の置換など色々試しましたが、
結局、CSVフォーマットをベタで作ってファイル保存の方法になりました。↓

最終形

Sub csv_create()
    Dim reg, fname As String
    Dim rSelection As Object
    Dim r, f, v
    Dim fs, ts As Object
    Dim data As String
    Dim dr As Integer

    Set fs = CreateObject("Scripting.FileSystemObject") ' 書き込み用ファイルオブジェクト
    Set reg = CreateObject("VBScript.RegExp")           ' 正規表現用
    Set rSelection = Selection                          ' 選択範囲

    dr = 1      ' 初期行数
    data = ""   ' 書き込みデータ

    ' 選択セル範囲を１セルずつループ
    For Each r In rSelection

' 表示データを出力する
'        v = r.Value  ' 計算結果データ
        v = r.Text   ' 表示データ

        If dr <> r.Row Then
            ' 末尾,を削除
            data = Left(data, Len(data) - 1)
            ' 改行コード(CRLF)追加
            data = data & vbCrLf
            ' 次の行へ
            dr = r.Row
        End If

        ' ダブルコーテーション追加
        reg.Pattern = "^"
        v = reg.Replace(v, """")
        reg.Pattern = "$"
        v = reg.Replace(v, """")

        ' データ連結
        data = data & v & ","
    Next

    ' 末尾,を削除
    data = Left(data, Len(data) - 1)

    'CSV形式でファイル保存
    fname = Application.GetSaveAsFilename(, "CSVファイル(*.csv),*.csv")

    '// FileSystemObjectで新規ファイル作成
    Set ts = fs.CreateTextFile(fname, True, False)
    ts.WriteLine (data)
    ts.Close

End Sub

エラーチェックとか特にやってないので問題あるかもですが、
とりあえず動きます

Excelへの設定

• 固定ファイルではなく、色々なExcelファイルでマクロ使用できるように個人用マクロブックに登録

• マクロ保存

ALT+F11でVBAエディタ起動

• ショートカットキー設定

作成したマクロを選択し、[オプション]

他のショートカットキーと被らないように

さいごに

文字コード指定や、改行コード指定などもそのうち対応したいと思います。

追記

CSV出力データがセル表示結果ではなく、計算結果となっていたため、修正

' 表示データを出力する
'        v = r.Value  ' 計算結果データ
        v = r.Text   ' 表示データ