Office関連

指定したセル範囲をUTF-8やEUC-JP等のテキストファイルとして出力するExcelマクロ

ExcelファイルをUTF-8のテキストファイルで出力する必要があったので、Streamオブジェクトを使った簡単なマクロを作ってみました。

Option Explicit

Public Sub Sample()
  If LCase(TypeName(Application.Selection)) <> "range" Then Exit Sub
  '選択範囲を[UTF-8,タブ区切り,CRLF改行,ダブルクォーテーション囲み有]で[C:\Test\Test.csv]として出力
  RangeToText Application.Selection, "C:\Test\Test.csv", "utf-8"
  '選択範囲を[EUC-JP,カンマ区切り,LF改行,ダブルクォーテーション囲み無]で[C:\Test\Test2.csv]として出力
  RangeToText Application.Selection, "C:\Test\Test2.csv", "euc-jp", ",", 10, False
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub

Private Sub RangeToText(ByVal TargetRange As Excel.Range, _
                        ByVal FilePath As String, _
                        ByVal CharacterSet As String, _
                        Optional ByVal Separator As String = vbTab, _
                        Optional ByVal LnSeparator As Long = -1, _
                        Optional ByVal FlgQuotes As Boolean = True)
  '指定したセル範囲をテキストファイルとして出力
  '----------------------------------------
  'TargetRange:出力対象セル範囲
  'FilePath:出力先のフォルダパス
  'CharacterSet:文字セット(HKEY_CLASSES_ROOT\MIME\Database\Charset 参照)
  'Separator:区切り文字
  'LnSeparator:行区切り文字(adCR:13, adCRLF:-1, adLF:10)
  'FlgQuotes:["]で囲むかどうかを指定
  Dim str As String
  Dim i As Long, j As Long
  Const adTypeText = 2
  Const adWriteChar = 0
  Const adWriteLine = 1
  Const adSaveCreateOverWrite = 2
  
  On Error Resume Next
  With CreateObject("ADODB.Stream")
    .Type = adTypeText
    .Charset = CharacterSet
    .LineSeparator = LnSeparator
    .Open
    For i = 1 To TargetRange.Rows.Count
      For j = 1 To TargetRange.Columns.Count
        If j = 1 Then
          If FlgQuotes = True Then
            str = ChrW(&H22) & TargetRange(i, j) & ChrW(&H22)
          Else
            str = TargetRange(i, j)
          End If
        Else
          If FlgQuotes = True Then
            str = str & Separator & ChrW(&H22) & TargetRange(i, j).Value & ChrW(&H22)
          Else
            str = str & Separator & TargetRange(i, j).Value
          End If
        End If
      Next
      If i = TargetRange.Rows.Count Then
        .WriteText str, adWriteChar
      Else
        .WriteText str, adWriteLine
      End If
    Next
    .SaveToFile FilePath, adSaveCreateOverWrite
    .Close
  End With
  If Err.Number <> 0 Then
    MsgBox "Err:" & Err.Description, vbCritical + vbSystemModal
    Exit Sub
  End If
  On Error GoTo 0
End Sub

文字セットや区切り文字を引数にしているので、例えば、[LF区切りのダブルクォーテーション囲み無しEUC-JPテキスト]といったファイルも簡単に作成することができます。

関連記事

  1. Office関連

    Unicodeブロックを元に指定した文字が平仮名なのかカタカナなのか漢字なのかを判別するVBAマクロ…

    以前書いた「ルビ(ふりがな)を一括設定するWordマクロ」記事で使った…

  2. Office関連

    クイックアクセスツールバーから履歴を表示するWordテンプレート

    Word MVPの新田さんのブログで「【Word 2013】クイックア…

  3. Office関連

    Internet Explorer用OneNoteアドオンを利用して指定したWebページをOneNo…

    「Evernote Webクリッパーで指定したWebページをEvern…

  4. Office関連

    Word 2013では文書にオンライン ビデオを挿入できるようになりました。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  5. Office関連

    Office製品のフィードバック先まとめ

    WordやExcel等のOffice製品を使っていて、「UIのこの日本…

  6. アイコン一覧

    Office 365アイコン(imageMso)一覧(X,Y,Z)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

コメント

  1. この記事へのコメントはありません。

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP