Excel

指定したセル範囲を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テキスト]といったファイルも簡単に作成することができます。

2014年4月の人気記事前のページ

Chromeアプリ版Office Onlineを使ってみました。次のページ

関連記事

  1. アイコン一覧

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

    ・Office 2013 アイコン一覧 NUM…

  2. Office関連

    未読メッセージ数を取得するOutlookマクロ

    Outlook 2007で追加されたFolderオブジェクトのUnRe…

  3. Excel

    オデッセイ コミュニケーションズ主催のExcel VBA入門セミナーに参加しました。

    今月19日に開催されたオデッセイ コミュニケーションズさん主催の「Ex…

  4. Office アドイン

    Office アドインの概要と開発方法を学ぶための自習書

    2018年10月27日(土)、品川の日本マイクロソフト本社で「2018…

  5. Office関連

    アクティブなIEのタブを閉じるVBAマクロ

    「VBA アクティブ IE タブ 閉じる」といったキーワード検索でのア…

  6. Office アドイン

    Office Scriptsってどんな機能?

    昨年の11月、Ignite 2019で発表されたオンライン版Excel…

コメント

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

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP