リストのアウトラインを定義してスタイルとして保存する

リスト用アウトラインを定義してスタイルとして保存するマクロです。

[新しいリスト スタイルの定義]コマンドからの操作を自動化したものです。ダイアログボックスで各項目を指定するのは複雑で手間もかかるため、一式をマクロにしてしまうというわけです。

リスト用アウトラインの定義については、以下のトピックを参照してください。

アウトラインと箇条書き・段落番号のポイント解説
箇条書き、段落番号とアウトラインについて解説します。 これらは、段落先頭に規則的な記号や連番を振るための便利な機能ですが...
koukimra.com

ここでは、見出し用のアウトラインの定義、箇条書き用のアウトラインの定義の2つを紹介します。

番号付き見出しのアウトラインを設定するマクロ

このマクロでは、見出し1~4 の段落スタイルに階層付きの連番を設定します。

Sub リストテンプレート設定_見出し()

    Const LISTSTY As String = "LS_NumberedTitle"
    Dim mySty As Style
    Dim myLT As ListTemplate
    
    s_ChkListStyle LISTSTY
    Set myLT = ActiveDocument.Styles(LISTSTY).ListTemplate
    
    ' 初期化
    s_ListTemplateClear myLT
    
    ' 個別設定
    Set mySty = ActiveDocument.Styles(wdStyleHeading1)
    With myLT.ListLevels(1)
        .NumberFormat = "第%1章"
        .TrailingCharacter = wdTrailingSpace
        .NumberStyle = wdListNumberStyleArabic
        .TextPosition = mySty.Font.Size
        With .Font
            .Bold = True
            .Color = -671039489
            .NameFarEast = mySty.Font.NameFarEast
            .Name = "Arial"
        End With
        .LinkedStyle = mySty
    End With
    
    Set mySty = ActiveDocument.Styles(wdStyleHeading2)
    With myLT.ListLevels(2)
        .NumberFormat = "%1.%2"
        .TrailingCharacter = wdTrailingSpace
        .NumberStyle = wdListNumberStyleArabic
        .TextPosition = mySty.Font.Size * 1.5
        With .Font
            .Bold = True
            .Color = -671039489
            .Name = "Arial"
        End With
        .LinkedStyle = mySty
    End With
    
    Set mySty = ActiveDocument.Styles(wdStyleHeading3)
    With myLT.ListLevels(3)
        .NumberFormat = "%1.%2.%3"
        .TrailingCharacter = wdTrailingSpace
        .NumberStyle = wdListNumberStyleArabic
        .TextPosition = mySty.Font.Size * 1.5
        With .Font
            .Bold = True
            .Color = -671039489
            .Name = "Arial"
        End With
        .LinkedStyle = mySty
    End With
    
    Set mySty = ActiveDocument.Styles(wdStyleHeading4)
    With myLT.ListLevels(4)
        .NumberFormat = "(%4)"
        .TrailingCharacter = wdTrailingSpace
        .NumberStyle = wdListNumberStyleArabic
        .TextPosition = mySty.Font.Size * 1.2
        With .Font
            .Color = -671039489
            .Name = "Arial"
        End With
        .LinkedStyle = mySty
    End With
    
    Set mySty = ActiveDocument.Styles(wdStyleHeading5)
    With myLT.ListLevels(5)
        .LinkedStyle = mySty
    End With
    
    Set mySty = Nothing
    Set myLT = Nothing
End Sub

箇条書き段落のアウトラインを設定するマクロ

このマクロでは、段落番号と箇条書きのスタイルに2階層付きの連番を設定します。

Sub リストテンプレート設定_箇条書き()

    Const LISTSTY As String = "LS_BulletPara"
    Const WID As Single = 20
    Dim myLT As ListTemplate
    
    s_ChkListStyle LISTSTY
    Set myLT = ActiveDocument.Styles(LISTSTY).ListTemplate
    '初期化
    s_ListTemplateClear myLT
    '個別設定
    With myLT.ListLevels(1)
        .NumberFormat = "%1."
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = 0
        .TextPosition = WID
        .TabPosition = WID
        With .Font
            .Color = -654278401
            .Name = "Arial"
        End With
        .LinkedStyle = "段落番号"
    End With
    
    With myLT.ListLevels(2)
        .NumberFormat = ChrW(61548)
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleBullet
        .NumberPosition = 0
        .TextPosition = WID
        .TabPosition = WID
        With .Font
            .Color = -654278401
            .Name = "Wingdings"
        End With
        .LinkedStyle = "箇条書き"
    End With
    
    With myLT.ListLevels(3)
        .NumberFormat = "%3)"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleArabic
        .NumberPosition = WID
        .TextPosition = WID * 2
        .TabPosition = WID * 2
        With .Font
            .Color = -654262273
            .Name = "Arial"
        End With
        .LinkedStyle = "段落番号 2"
    End With
    
    With myLT.ListLevels(4)
        .NumberFormat = ChrW(61607)
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleBullet
        .NumberPosition = WID
        .TextPosition = WID * 2
        .TabPosition = WID * 2
        With .Font
            .Color = -654262273
            .Name = "Wingdings"
        End With
        .LinkedStyle = "箇条書き 2"
    End With
    Set myLT = Nothing

End Sub

アウトライン設定の初期化サブルーチン

上記の2つのマクロから呼び出される共通のサブルーチンです。

'リストスタイルの確認と作成
Private Sub s_ChkListStyle(sNAME As String)

    Dim oSty As Style
    On Error Resume Next
    Set oSty = ActiveDocument.Styles(sNAME)
    
    If Err.Number <> 0 Then
        ActiveDocument.Styles.Add Name:=sNAME, Type:=wdStyleTypeList
    Else
        Set oSty = Nothing
    End If
End Sub

'リストテンプレートの各レベルの設定を初期化
Private Sub s_ListTemplateClear(oLT As ListTemplate)
    
    Dim i As Long
    
    For i = 1 To 9
        With oLT.ListLevels(i)
            .NumberFormat = ""
            .TrailingCharacter = wdTrailingNone
            .NumberStyle = wdListNumberStyleNone
            .NumberPosition = 0
            .Alignment = wdListLevelAlignLeft
            .TextPosition = 0
            .TabPosition = wdUndefined
            .ResetOnHigher = True
            .StartAt = 1
            With .Font
                .Name = ""
                .Color = wdUndefined
                .Size = wdUndefined
                .Bold = wdUndefined
                .Italic = wdUndefined
                .StrikeThrough = wdUndefined
                .Subscript = wdUndefined
                .Superscript = wdUndefined
                .Shadow = wdUndefined
                .Outline = wdUndefined
                .Emboss = wdUndefined
                .Engrave = wdUndefined
                .AllCaps = wdUndefined
                .Hidden = wdUndefined
                .Underline = wdUndefined
                .Animation = wdUndefined
                .DoubleStrikeThrough = wdUndefined
            End With
            .LinkedStyle = ""
        End With
    Next i
End Sub

解説

リストスタイルの作成

s_ChkListStyle サブルーチンで、対象のリストスタイルの有無を確認して、ない場合は作成します。

Document.Styles.Add name:=STYLENAME, Type:=wdStyleTypeList

リストスタイルの作成はType を wdStyleTypeList にする以外は、段落スタイルの作成と同様です。

名前は英数字にしましょう。日本語も使えますが、[アウトライン]ボタンから表示される「リストのスタイ ル」をポイントしたときに名前が表示されません。

アウトラインの定義は、リストスタイルとリンクした ListTemplate オブジェクトで行います。

アウトラインの各レベル定義の初期化

アウトラインの各レベルの定義は、ListTemplate.ListLevels コレクションの各メンバーの各プロパティで扱います。メンバーは1~9です。
s_ListTemplateClear サブルーチンで、これらのプロパティを初期化しています。wdUndefined は「アウトライン専用値の指定なし」になります。例えば、Font.Size = wdUndefined なら、アウトラインが設定された段落の文字サイズと同じになります。

アウトラインの各レベルの定義

アウトラインの各レベルの各プロパティにつき、初期状態から変更したい値だけを定義していきます。

LinkedStyle プロパティ

段落スタイルの種類に応じてアウトラインのレベルを決める場合に指定します。このプロパティが "" の場合は、段落のインデントでレベルが決まります。

複数のリストスタイルの切り替え
必要に応じて複数のリストスタイルを切り替えて使うこともできます。そうした場合は、LinkedStyle プロパティ指定専用のマクロを用意します。一つのスタイルを複数のリストスタイルに指定できないため、一方を指定すれば他方の指定は解除されます。
スポンサーリンク
タイトルとURLをコピーしました