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