はてな記法をMS Wordのスタイルへ変換

Hatena2Word.vb

Option Explicit

Sub ClearMyStyle()
    '' 独自スタイルの削除
    Dim myst As Variant
    Dim myStNames() As Variant
    Dim st As Style
    Dim lg As ListGallery
    Dim i As Long
    
    myStNames = Array("My本文字下げ", "My見出し1", "My見出し2", "My見出し3")
    For Each st In ActiveDocument.Styles
        For Each myst In myStNames
            If st = myst Then
                st.Delete
                Exit For
            End If
        Next
    Next
    
    For Each lg In ListGalleries
        For i = 1 To 7
            lg.Reset (i)
        Next
    Next
End Sub

Sub HatenaStylesAdd()
    '' 独自スタイルの定義
    Dim StName As String
    Dim MyStyle As Style
    
    ClearMyStyle
    '' My本文字下げ
    StName = "My本文字下げ"
    Set MyStyle = ActiveDocument.Styles.Add(Name:=StName, Type:=wdStyleTypeParagraph)
    With MyStyle
        With .ParagraphFormat
            .CharacterUnitFirstLineIndent = 1
        End With
    End With
    
    '' My見出し1
    StName = "My見出し1"
    Set MyStyle = ActiveDocument.Styles.Add(Name:=StName, Type:=wdStyleTypeParagraph)
    With MyStyle
        With .Font
            .Bold = True
            .Name = "ＭＳ ゴシック"
        End With
        With .ParagraphFormat
        End With
    End With
    
    '' My見出し2
    StName = "My見出し2"
    Set MyStyle = ActiveDocument.Styles.Add(Name:=StName, Type:=wdStyleTypeParagraph)
    With MyStyle
        With .Font
            .Bold = True
            .Name = "ＭＳ ゴシック"
        End With
        With .ParagraphFormat
            .IndentCharWidth (1)
        End With
    End With
    
    '' My見出し3
    StName = "My見出し3"
    Set MyStyle = ActiveDocument.Styles.Add(Name:=StName, Type:=wdStyleTypeParagraph)
    With MyStyle
        With .Font
            .Bold = True
            .Name = "ＭＳ ゴシック"
        End With
        With .ParagraphFormat
            .IndentCharWidth (2)
        End With
    End With
    
    '' 箇条書き
    With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
        .NumberFormat = "・"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleBullet
        .NumberPosition = MillimetersToPoints(0)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = MillimetersToPoints(3.7)
        .TabPosition = MillimetersToPoints(3.7)
        .ResetOnHigher = 0
        .StartAt = 1
        .LinkedStyle = ""
    End With
    ListGalleries(wdBulletGallery).ListTemplates(1).Name = ""
    
    With ListGalleries(wdBulletGallery).ListTemplates(2).ListLevels(1)
        .NumberFormat = "・"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleBullet
        .NumberPosition = MillimetersToPoints(3.7)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = MillimetersToPoints(3.7 * 2)
        .TabPosition = MillimetersToPoints(3.7 * 2)
        .ResetOnHigher = 0
        .StartAt = 1
        .LinkedStyle = ""
    End With
    ListGalleries(wdBulletGallery).ListTemplates(2).Name = ""

    With ListGalleries(wdBulletGallery).ListTemplates(3).ListLevels(1)
        .NumberFormat = "・"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleBullet
        .NumberPosition = MillimetersToPoints(3.7 * 1.9)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = MillimetersToPoints(3.7 * 3)
        .TabPosition = MillimetersToPoints(3.7 * 3)
        .ResetOnHigher = 0
        .StartAt = 1
        .LinkedStyle = ""
    End With
    ListGalleries(wdBulletGallery).ListTemplates(3).Name = ""
End Sub

Sub Hatena2Word()
    '' はてな記法を独自定義スタイルに変換
    
    Dim para As Paragraph
    
    For Each para In ActiveDocument.Paragraphs
        With para.Range.Characters
        '' 条件合致なし
        para.Style = "本文字下げ"
        '' 見出し
        If .First = "*" Then
            .First.Delete
            para.Style = "My見出し1"
            If .First = "*" Then
                .First.Delete
                para.Style = "My見出し2"
                If .First = "*" Then
                    .First.Delete
                    para.Style = "My見出し3"
                End If
            End If
        End If
        '' 箇条書き
        If .First = "-" Then
        .First.Delete
            If .First = "-" Then
            .First.Delete
                If .First = "-" Then
                    .First.Delete
                    para.Range.ListFormat.ApplyListTemplate _
                        ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(3), _
                        ContinuePreviousList:=False, _
                        ApplyTo:=wdListApplyToWholeList, _
                        DefaultListBehavior:=wdWord9ListBehavior
                        GoTo LABEL1
                End If
                para.Range.ListFormat.ApplyListTemplate _
                    ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(2), _
                    ContinuePreviousList:=False, _
                    ApplyTo:=wdListApplyToWholeList, _
                    DefaultListBehavior:=wdWord9ListBehavior
                    GoTo LABEL1
            End If
            para.Range.ListFormat.ApplyListTemplate _
                ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(1), _
                ContinuePreviousList:=False, _
                ApplyTo:=wdListApplyToWholeList, _
                DefaultListBehavior:=wdWord9ListBehavior
        End If
LABEL1:
        '' 番号付き箇条書き
        If .First = "+" Then
            .First.Delete
            para.Style = "段落番号"
            para.Range.ListFormat.ListIndent
            If .First = "+" Then
                .First.Delete
                para.Range.ListFormat.ListIndent
                If .First = "+" Then
                    .First.Delete
                    para.Range.ListFormat.ListIndent
                End If
            End If
        End If
        End With
    Next
End Sub