Excelの表からMarkdown記法化したかったので作成しました。
コード
- htmlにおいてソース上に「&」や「"」が混入してしまうことがあるため、本ページ上のソースをコピペせず、「ダウンロード（txt）」ボタンをご利用ください。（私の利用する環境のバグに起因しており、解消方法をさぐっていますが、現状は根本対処ができておりません）
Option Explicit
Sub CellToBacklogTable()
'------------------------------------------------------------------------------
' 選択した範囲を Backlog用Markdownのテーブル に変換して出力する
' [出力]
' 方法1. イミディエイトウィンドウに出力
' 方法2. Windows用のメモ帳への受け渡しは変数かつクリップボード経由
'（どちらもデータがあまりに多いのが推奨できない方式のため、1000 セル以上選択されていると中断）
'
'------------------------------------------------------------------------------
'出力先（'1:イミディエイトウィンドウ、2:Windowsメモ帳）
Const lngOutputFlag = 1
'インデントいれたいときに設定（0はなし、1でスペース4つ、2でスペース8つ…。インデントが有効なのは箇条書きの次の段落）
Const lngIndentCount As Long = 0
'改行コード（Windows/vbCrLf or vbLf）
Const strTextLS = vbLf
Dim MsgRtn As String 'メッセージボックスの返り値
Dim wkRng As Range '選択範囲記憶
Dim strText As Variant '出力データ
Dim i As Long
Dim r As Long, c As Long
Dim rowSt As Long, rowEd As Long, colSt As Long, colEd As Long
Dim strIndent As String
Dim strTagLine As String
'Markdown文字列
Const strTagTrSt As String = "| "
Const strTagTrMd As String = " | "
Const strTagTrEd As String = " |"
Const strTagLineLeft As String = "----"
Const strTagLineCenter As String = ":----:"
Const strTagLineRight As String = "----:"
'開始メッセージ
MsgRtn = MsgBox("選択している範囲が出力されます。処理を開始しますか？" & vbCrLf & vbCrLf & _
"・見出し行は1行固定です。（出力されたコードを編集してね）" & vbCrLf & _
"・セル結合は無視されます。（出力されたコードを編集してね）" & vbCrLf & _
"・セル内改行は<br>タグに置換されます。", _
vbOKCancel + vbInformation, Title:="Backlog (Markdown記法) テーブル 出力")
If MsgRtn = vbCancel Then Exit Sub
'インデント幅計算
If lngIndentCount = 0 Then
strIndent = ""
Else
strIndent = String(lngIndentCount * 4, " ")
End If
'選択範囲に値があるか確認（値がなければ終了）
If WorksheetFunction.CountA(Selection) = 0 Then
Exit Sub
End If
'出力先チェック
If lngOutputFlag = 1 Or lngOutputFlag = 2 Then
Else
Exit Sub
End If
'選択範囲を記憶
Set wkRng = Selection
If Selection.Count > 200 Then
MsgRtn = MsgBox("セルが200個以上選択されていますが、実行しますか？" & vbCrLf & vbCrLf, _
vbOKCancel + vbInformation + vbDefaultButton2, Title:="確認")
If MsgRtn = vbCancel Then Exit Sub
ElseIf Selection.Count > 1000 Then
MsgRtn = MsgBox("セルが1000個以上選択されているので、中断します。" & vbCrLf & vbCrLf & _
vbExclamation + vbInformation, Title:="中断")
Exit Sub
End If
'列と行を取得
rowSt = Selection(1).Row
rowEd = Selection(Selection.Count).Row
colSt = Selection(1).Column
colEd = Selection(Selection.Count).Column
'セル内容を出力
For r = rowSt To rowEd
strText = strText & strIndent & strTagTrSt
For c = colSt To colEd
'右端ではない列
If c <> colEd Then
strText = strText & Replace(Cells(r, c).Text, vbLf, "<br>") & strTagTrMd
'右端の列
Else
strText = strText & Replace(Cells(r, c).Text, vbLf, "<br>") & strTagTrEd & strTextLS
End If
Next c
'1行目が出力された直後に見出し行とデータ行を分けるための線を出力
If r = rowSt And rowEd > rowSt Then
strText = strText & strIndent & strTagTrSt
For c = colSt To colEd
strTagLine = strTagLineLeft
If c <> colEd Then
strText = strText & strTagLine & strTagTrMd
Else
strText = strText & strTagLine & strTagTrEd & strTextLS
End If
Next c
End If
Next r
strText = strText & strTextLS
If lngOutputFlag = 1 Then
Debug.Print strText
ElseIf lngOutputFlag = 2 Then
'クリップボードに格納
With CreateObject("Forms.TextBox.1")
.MultiLine = True
.Text = strText
.SelStart = 0
.SelLength = .TextLength
.Copy
End With
'待ち（処理が追い付かない場合、調整）
Application.Wait Now() + TimeValue("00:00:03")
'メモ帳起動
Shell "notepad", 1
'待ち（処理が追い付かない場合、調整）
Application.Wait Now() + TimeValue("00:00:02")
'メモ帳に貼り付け
SendKeys "^V", True
End If
'元の選択範囲を選ぶ
wkRng.Select
End Sub
