段落罫線を気軽に追加する(Word)
段落罫線を気軽に追加する
段落罫線を追加するのはめんどくさい
文書に区切りの線を入れたいときがある。
たとえば、
こいつを、
こんなふうにしたいときである。
(あ。「そんなもん、ハイフン三つ連チャンで入力したらいいじゃねえか。タコ!」というツッコミはなしね。それでうまくいかなくて、段落罫線をいじるしかない場合を想定しているので。)
しかし、ただこれだけのことが異様にめんどくさい。
どのぐらいめんどくさいか、今からお目にかけよう。
「そんなもん、どーでもええわい。早よ、結論を言えや。」と言う人は、コチラをどうぞ。
段落罫線を追加する手順
段落罫線を追加する手順を示す。(各手順のカッコ内は、最低限必要なクリックの数/累計クリック数。)
まず、「デザイン」タブをクリックする。(1回/1回)
「ページ罫線」をクリックする。(1回/2回)
「罫線」タブをクリックする。(1回/3回)
「設定対象」ドロップダウンを展開し、「段落」を選択する。(2回/5回)
罫線の位置を設定し、[オプション]ボタンをクリックする。(2回/7回)
(線種や色、太さはデフォルトのまま、という場合。当然、これらを設定するとクリック数は増える。)
段落から罫線への距離を設定して、[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
要するに、
こいつの修正版。ちょっとぶさいくな修正結果だが。(エレガントな方法を知っている人がいたら教えろえてください。)
リスト2のマクロをクイック アクセス ツール バーに登録して、実行した様子が、
コチラ。
楽勝!
おわりに
こういう、〝通常の操作がメンドクサイやつをマクロ化する〟というのが、Wordの場合のVBAの使いどころなんじゃないかなあ、と思い始めています。