段落罫線を気軽に追加する(Word)

段落罫線を気軽に追加する

段落罫線を追加するのはめんどくさい

文書に区切りの線を入れたいときがある。

たとえば、

f:id:akashi_keirin:20220220083029p:plain

こいつを、

f:id:akashi_keirin:20220220083032p:plain

こんなふうにしたいときである。

(あ。「そんなもん、ハイフン三つ連チャンで入力したらいいじゃねえか。タコ!」というツッコミはなしね。それでうまくいかなくて、段落罫線をいじるしかない場合を想定しているので。)

しかし、ただこれだけのことが異様にめんどくさい。

どのぐらいめんどくさいか、今からお目にかけよう。

「そんなもん、どーでもええわい。早よ、結論を言えや。」と言う人は、コチラをどうぞ。

段落罫線を追加する手順

段落罫線を追加する手順を示す。(各手順のカッコ内は、最低限必要なクリックの数/累計クリック数。)

f:id:akashi_keirin:20220220083035p:plain

まず、「デザイン」タブをクリックする。(1回/1回)

f:id:akashi_keirin:20220220083038p:plain

「ページ罫線」をクリックする。(1回/2回)

f:id:akashi_keirin:20220220083040p:plain

「罫線」タブをクリックする。(1回/3回)

f:id:akashi_keirin:20220220083043p:plain

「設定対象」ドロップダウンを展開し、「段落」を選択する。(2回/5回)

f:id:akashi_keirin:20220220083045p:plain

罫線の位置を設定し、[オプション]ボタンをクリックする。(2回/7回)

(線種や色、太さはデフォルトのまま、という場合。当然、これらを設定するとクリック数は増える。)

f:id:akashi_keirin:20220220083048p:plain

段落から罫線への距離を設定して、[OK]ボタンをクリックする。(1回/8回)

(もちろん、段落から罫線への距離をスピンボタンをクリックして設定すると、その回数に応じてクリック数は増える。画像だと「下」を「5」にしているので、4回クリックすることになる。)

で、最後に「線種とページ罫線と網かけの設定」ダイアログボックスの[OK]ボタンをクリックすることになるので、最低でも実に9回もクリックをしないと、段落罫線一つ追加できないのである。(段落から罫線への距離をデフォルトのままにしたら7回。)

これはめちゃくちゃめんどくさい。

そこで、VBAの出番なのである!

段落罫線を追加するFunction

次のようなFunctionを作った。

リスト1
Public Sub AddParagraphBorder( _
             ByVal a_Paragraph As Paragraph, _
             ByVal a_BorderType As WdBorderType, _
    Optional ByVal a_LineStyle As WdLineStyle = wdLineStyleSingle, _
    Optional ByVal a_LineWidth As WdLineWidth = wdLineWidth050pt, _
    Optional ByVal a_Color As WdColor = wdColorAutomatic, _
    Optional ByVal a_DistanceFrom As Long = 1)
  Dim tgtPara As Paragraph
  Set tgtPara = a_Paragraph
  'a_DistanceFromが負の数だったら、「1」にする'
  Dim distPts As Long
  If a_DistanceFrom < 0 Then
    distPts = 1
  Else
    distPts = a_DistanceFrom
  End If
  '元の罫線情報を取得しておく'
  With tgtPara.Borders
    '罫線への距離'
    Dim distTop As Long: distTop = .DistanceFromTop
    Dim distBottom As Long: distBottom = .DistanceFromBottom
    Dim distLeft As Long: distLeft = .DistanceFromLeft
    Dim distRight As Long: distRight = .DistanceFromRight
    '罫線の種類・太さ・色'
    With .Item(wdBorderTop)
      Dim topStyle As WdLineStyle: topStyle = .LineStyle
      Dim topWidth As WdLineWidth: topWidth = .LineWidth
      Dim topColor As WdColor: topColor = .Color
    End With
    With .Item(wdBorderBottom)
      Dim bottomStyle As WdLineStyle: bottomStyle = .LineStyle
      Dim bottomWidth As WdLineWidth: bottomWidth = .LineWidth
      Dim bottomColor As WdColor: bottomColor = .Color
    End With
    With .Item(wdBorderLeft)
      Dim leftStyle As WdLineStyle: leftStyle = .LineStyle
      Dim leftWidth As WdLineWidth: leftWidth = .LineWidth
      Dim leftColor As WdColor: leftColor = .Color
    End With
    With .Item(wdBorderRight)
      Dim rightStyle As WdLineStyle: rightStyle = .LineStyle
      Dim rightWidth As WdLineWidth: rightWidth = .LineWidth
      Dim rightColor As WdColor: rightColor = .Color
    End With
  End With
  '指定された罫線の形態を上書きする'
  Select Case a_BorderType
    Case wdBorderTop
      topStyle = a_LineStyle: topWidth = a_LineWidth
      topColor = a_Color: distTop = distPts
    Case wdBorderBottom
      bottomStyle = a_LineStyle: bottomWidth = a_LineWidth
      bottomColor = a_Color: distBottom = distPts
    Case wdBorderLeft
      leftStyle = a_LineStyle: leftWidth = a_LineWidth
      leftColor = a_Color: distLeft = distPts
    Case wdBorderRight
      rightStyle = a_LineStyle: rightWidth = a_LineWidth
      rightColor = a_Color: distRight = distPts
  End Select
  '罫線の形態を再セットする'
  With tgtPara.Borders
    .DistanceFromTop = distTop
    .DistanceFromBottom = distBottom
    .DistanceFromLeft = distLeft
    .DistanceFromRight = distRight
    With .Item(wdBorderTop)
      If topStyle = wdLineStyleNone Then
      Else
        .LineStyle = topStyle: .LineWidth = topWidth
        .Color = topColor
      End If
    End With
    With .Item(wdBorderBottom)
      If bottomStyle = wdLineStyleNone Then
      Else
        .LineStyle = bottomStyle: .LineWidth = bottomWidth
        .Color = bottomColor
      End If
    End With
    With .Item(wdBorderLeft)
      If leftStyle = wdLineStyleNone Then
      Else
        .LineStyle = leftStyle: .LineWidth = leftWidth
        .Color = leftColor
      End If
    End With
    With .Item(wdBorderRight)
      If rightStyle = wdLineStyleNone Then
      Else
        .LineStyle = rightStyle: .LineWidth = rightWidth
        .Color = rightColor
      End If
    End With
  End With
End Sub

こんな感じ。説明はめんどくさいから省略。

簡単に手順だけ示しておく。

  • 元の段落罫線の状態を取得
  • 引数で渡された箇所の罫線情報だけ上書きする

たったこれだけ。

こんなにカンタンになりました

カーソルのある段落の下に5ポイント離して罫線を引くマクロを作る。

スト2
Public Sub AddParagraphBottomBorder()
  Dim tgtDoc As Document
  Set tgtDoc = ActiveDocument
  Dim tgtPara As Paragraph
  Set tgtPara = tgtDoc.Paragraphs( _
                  ParagraphUtil.GetParagraphIndex(Selection.Range))
  Call ParagraphUtil.AddParagraphBorder(tgtPara, wdBorderBottom, _
                                        wdLineStyleSingle, _
                                        wdLineWidth050pt, _
                                        wdColorAutomatic, 5)
End Sub

ちなみに、上掲コード中のGetParagraphIndexは、標準モジュールParagraphUtil内に書いた自作のメソッド。

一応、そのコードも載っけておく。

リスト3
Public Function GetParagraphIndex( _
            ByVal a_Target As Range) As Long
  Dim ret As Long
  Dim rng As Range
  Set rng = a_Target
  rng.Start = 0
  ret = rng.Paragraphs.Count
  Dim pos As Long
  pos = rng.End
  'カーソルが全体の先頭にあるときは pos - 1 でエラーになる'
  If pos = 0 Then GoTo ReturnValue
  Dim char As String
  char = rng.Parent.Range(pos - 1, pos).Text
  '直前が改段落マークのときはカーソルが段落の先頭にある'
  If char = Chr(13) Then
    ret = ret + 1
  End If
ReturnValue:
  GetParagraphIndex = ret
End Function

要するに、

akashi-keirin.hatenablog.com

こいつの修正版。ちょっとぶさいくな修正結果だが。(エレガントな方法を知っている人がいたら教えろえてください。)

リスト2のマクロをクイック アクセス ツール バーに登録して、実行した様子が、

f:id:akashi_keirin:20220220083051p:plain

f:id:akashi_keirin:20220220083054g:plain

コチラ。

楽勝!

おわりに

こういう、〝通常の操作がメンドクサイやつをマクロ化する〟というのが、Wordの場合のVBAの使いどころなんじゃないかなあ、と思い始めています。