見出しマップに表示される文字の大きさを変更するマクロです。
見出しマップというのは、文書中の「見出し」をワードの作業画面の左側に階層表示する機能です。
メニューの 表示＞見出しマップ で表示のオン・オフを切り替えられます。
見出し設定した位置までカーソルをワンクリックで移動できるので、文書の編集作業において非常に便利です。
＜目次＞
作成背景
私の場合は、明細書作成時に段落番号を見出し登録して、画面左側に段落番号一覧が「見出しマップ」として表示されるようにしています。
よって、特定の段落の文章を編集したい場合に、見出しマップの段落をクリックしてその段落に移動できるというわけです。
今回は、その「見出しマップ」の表示文字の大きさを変更するマクロです。
この表示文字が大きすぎると、編集領域が圧迫されて不便ですので、簡単に変更できるようにしました。
参考資料
前回のブログで紹介した「Wordでテキパキ」のP.57に「『見出しマップ』のフォントを変える」という記事があります。
この作業（７ステップで説明）を１ステップでできるようにしました。
プログラム
Sub 見出しマップの文字サイズ変更()
Dim Message As String
Dim Title As String
Dim MyValue As Integer
'メッセージ、タイトルの設定
10 Message = "ポイントを入力してください。"
20 Title = "見出しマップの文字のポイント設定"
'インプットボックスを表示
30 MyValue = InputBox(Message, Title)
'文字サイズを変更
40 ActiveDocument.Styles("見出しマップ").Font.Size = MyValue
End Sub
プログラム解説
10行～30行
文字のサイズを入力します。
Inputbox関数を用いており、入力された数字は、整数型の変数であるMyValueに格納されます。
40行
見出しマップに表示される文字の大きさをMyValueに格納されている数値に設定します。
マクロの作り方
フォントサイズを８にする場合の作業を、マクロの自動記録で記録してコードを書き出します。
具体的な作業内容は、「Wordでテキパキ」のP.57に記載されているとおりです。
すると、以下のようなコードが得られます。
ぱっと見て、着色部分しかいらないことに気がつきます。
なぜなら、他の項目は、上のイメージに示したとおり、「スタイルの変更」ダイアログボックスの項目に対応しているだけで、自動で記録されてしまっているコードだからです。
このあたりの判断は、マクロの自動記録を何度もやって、不要箇所を削除する作業を繰り返してみると感覚的にわかるようになります。
では、必要なコードを抜き出します。
With ActiveDocument.Styles("見出しマップ").Font
.Size = 8
End With
は、
ActiveDocument.Styles("見出しマップ").Font.Size = 8
と同じ意味ですから、この上記のコードを用いて40行をつくってみました。
自動記録されたコード
Sub Macro()
With ActiveDocument.Styles("見出しマップ")
.AutomaticallyUpdate = False
.BaseStyle = "標準"
.NextParagraphStyle = "見出しマップ"
End With
With ActiveDocument.Styles("見出しマップ").Font
.NameFarEast = "ＭＳ ゴシック"
.NameAscii = "Arial"
.NameOther = "Arial"
.Name = "ＭＳ ゴシック"
.Size = 8
.Bold = False
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Scaling = 100
.Kerning = 1
.Animation = wdAnimationNone
.DisableCharacterSpaceGrid = False
.EmphasisMark = wdEmphasisMarkNone
End With
End Sub