Excelからマークダウンの一覧表を作成するマクロ

Home   »   Excelからマークダウンの一覧表を作成するマクロ

Attribute VB_Name = "Module1"
Option Explicit
Sub CreateMarkdownTable()
Attribute CreateMarkdownTable.VB_Description = "create markdown table"
Attribute CreateMarkdownTable.VB_ProcData.VB_Invoke_Func = "t\n14"
'
' CreateMarkdownTable Macro
' create markdown table
'
' Keyboard Shortcut: Ctrl+t
'

    ' セルが選択されていない場合はエラー終了
    If Selection Is Nothing Or TypeName(Selection) <> "Range" Then
        MsgBox "セルを選択してください。", vbExclamation
        Exit Sub
    End If
    
    ' 選択されているセル範囲を格納
    Dim targetRange As Range
    Set targetRange = Selection

    ' クリップボードに格納する文字列
    Dim ret As String
    ret = ""
    Dim r As Long, c As Long
    ' 装飾
    Dim modLeft As String, modRight As String
    
    For r = 0 To targetRange.Rows.Count - 1 Step 1
        ret = ret & "|"
        For c = 0 To targetRange.Columns.Count - 1 Step 1
            With targetRange.Offset(r, c).Range("A1")
                modLeft = "": modRight = ""
                If .Font.Bold = True Then
                    modLeft = modLeft & "**": modRight = "**" & modRight
                End If
                If .Font.Italic = True Then
                    modLeft = modLeft & "*": modRight = "*" & modRight
                End If
                If .Font.Strikethrough = True Then
                    modLeft = modLeft & "~~": modRight = "~~" & modRight
                End If
                ret = ret & modLeft & .Value & modRight & "|"
            End With
        Next c
        ret = ret & vbCrLf
        ' 最初の行だけ
        If r = 0 Then
            ret = ret & "|"
            For c = 0 To targetRange.Columns.Count - 1 Step 1
                With targetRange.Offset(r, c).Range("A1")
                    If .HorizontalAlignment = xlRight Then
                        ret = ret & "--:|" ' 右寄せ
                    ElseIf .HorizontalAlignment = xlCenter Then
                        ret = ret & ":--:|" ' 中央
                    Else
                        ret = ret & ":--|" ' 左寄せ
                    End If
                End With
            Next c
            ret = ret & vbCrLf
        End If
    Next r
    
    ' クリップボードを宣言
    Dim dt As Object
    Set dt = New DataObject
   
    dt.SetText ret
    dt.PutInClipboard
    MsgBox "クリップボードに格納しました。"


End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *