Excelの表をQiitaに貼る変換マクロ

エクセルの表をQiita用に変換してクリップボードにコピーするEXCELアドインを作ってみました。

markdownTable.zip

変換結果

|A|B|C|
|--:|--:|--:|
|1|2|3|
|4|5|6|

＜参考＞

• Web上でMarkdownに変換できるサイト:Markdown Tables Generator [(Qiita投稿記事)]
  (http://qiita.com/QUENCH/items/d77d0983d4a6d9d7de8e)

アドインの追加方法

• Excel2007/2010/2013
  ファイル->オプション->アドイン->設定ボタンで追加
  参考ページ：http://www.h3.dion.ne.jp/~sakatsu/Excel2007_Addin_Inst.htm

• ～Excel2003/Mac版Excel2011
  メニューのツール->アドインで追加

使い方

1.テーブルを選択して右クリック。
2.ポップアップメニューのmarkdownTableを選択。
3.Qiitaに貼り付け。

＜補足＞
・< > | はエンコード、改行は```
```に変換します。
・2行目で左右寄せを判断します。

VBAソースコード

'①クリップボードを使うためにダミーの標準フォーム追加

'②ThisWorkbook,標準モジュールに以下ソースを追加

'③一旦xlsmで保存後、名前を付けて保存でアドイン(xla)形式を選択して保存

'ThisWorkBookに記述
'---------------------------------------------
'アドイン追加時にメニュー追加
Private Sub Workbook_AddinInstall()
    AddMenuMarkdownTable
End Sub

'アドイン削除時にメニュー削除
Private Sub Workbook_AddinUninstall()
    DelMenuMarkdownTable
End Sub
'---------------------------------------------

'標準モジュール
'----------------------------------------
'
' 機能:     表をMarkDownに変換してクリップボードにコピー
'
' 備考:
'   ・改行 < > | はエンコード
'   ・2行目で左右寄せを判断
'
Sub markDownTableToClipboard()

    Dim markdown As String: markdown = ""

    For Row = 0 To Selection.Rows.Count - 1

        '行データ作成
        markdown = markdown + "|"

        For Col = 0 To Selection.Columns.Count - 1
            Dim celText As String: celText = Selection(1).Offset(Row, Col).Text

            'エンコード
            celText = Replace(celText, "<", "&lt;")
            celText = Replace(celText, ">", "&gt;")
            celText = Replace(celText, "|", "&#124;")
            celText = Replace(celText, vbCrLf, "<BR>")
            celText = Replace(celText, vbCr, "<BR>")
            celText = Replace(celText, vbLf, "<BR>")

            markdown = markdown + celText + "|"
        Next

        '位置設定行(2行目)
        If Row = 0 Then

            markdown = markdown + vbCrLf + "|"

            For Col = 0 To Selection.Columns.Count - 1

                Dim chkCell As Range: Set chkCell = Selection(1).Offset(1, Col)

                '中央寄せ
                If chkCell.HorizontalAlignment = xlCenter Then
                    markdown = markdown + ":--:|"

                '右寄せ
                ElseIf chkCell.HorizontalAlignment = xlRight Or _
                       (chkCell.HorizontalAlignment = xlGeneral And 0 < Len(chkCell.Text) And IsNumeric(chkCell)) Then
                    markdown = markdown + "--:|"

                '左寄せ
                Else
                    markdown = markdown + ":--|"
                End If

            Next

        End If

        markdown = markdown + vbCrLf

    Next

    ' クリップボードにコピー
    If Application.OperatingSystem Like "*Mac*" Then
        ' Is Mac.
        markdown = Replace(markdown, "\", "\\")
        markdown = Replace(markdown, Chr(34), "\" & Chr(34))
        MacScript ("set the clipboard to " & Chr(34) & markdown & Chr(34))
    Else
        ' Is Windows.
        Dim CB As New DataObject
        With CB
            .SetText markdown
            .PutInClipboard
        End With
    End If

End Sub

'メニュー追加
Sub AddMenuMarkdownTable()
    DelMenuMarkdownTable

    Dim Newb
    Set Newb = Application.CommandBars("Cell").Controls.Add()
    With Newb
        .Caption = "markdownTable"
        .OnAction = "markDownTableToClipboard"
        .BeginGroup = False
    End With
End Sub

'メニュー削除
Sub DelMenuMarkdownTable()
  On Error GoTo ErrHand
    Application.CommandBars("Cell").Controls("markdownTable").Delete
ErrHand:
End Sub