【Word VBA】原稿用紙の罫線を引くWordマクロ

2016年1月12日

, , ,

冬休みに小学生の宿題の手伝いをしました。

原稿用紙に作文をするのです。原稿用紙にびっしり書き込んだ後に誤字や脱字を発見してしまうと大変ですね。

先生の赤ペンの通りに文字を書いているつもりが、いつのまにか1文字飛ばしてしまったり。

修正する箇所の段落だけでなく、それ以降の段落も全て消して書き直しの場合があります。

せっかく丁寧に書いた文章を消しゴムで消すのでは心が折れます（笑）。

私はワープロ（Word）を使って文章を書くことに慣れてしまっているので、このような修正作業は大変だなと感じました。私も小学生のころはやっていたのですが。

そこで、Wordを使ってなんとか手伝いできないかなと思い試行錯誤をしました。

誤記をしやすいのであれば、原稿用紙に見本で文章を書いてあげて、それを写してもらえばいい！というわけです。

原稿用紙の通りに文章を入力して印刷したら、この印刷した通りに原稿用紙に写すだけで作文が完成するはず。

もし写し間違いがある場合には行末や行頭の文字がずれるので、ミスを確認しやすくなります。

Wordには、［原稿用紙設定］ボタンが［ページレイアウト］タブに用意されておりますが、この原稿用紙は文字数が指定されていて学校指定の変則的な原稿用紙の文字数（たとえば、28文字×40行）にあいません。

なので自分で市販の原稿用紙用の設定をする必要があります。これが案外面倒です。

さらに、仮に行数や文字数の指定でWordで文章を作成したとしても印刷すると罫線は印刷されないので、子どもが原稿用紙に書き写すときに書きづらいのです。

ならば罫線を自分で入れるしかない！

ということで、マクロを作ってしまいました。

お子さんの作文の宿題を手伝う親御さんは、お子さんが書いた文章をWordで入力してあげなければなりません（笑）。

この一手間をかければ、あとはこのマクロで原稿用紙の様式に表示変更して印刷するだけです。

このマクロでできること

横書きの文書を縦書きの原稿用紙表示に変換します。

（実行前）
文章を完成させたところ。よい子は段落先頭に全角スペースを1つ挿入することをお忘れなく。

原稿用紙

（実行後）
1ページ目
句点がしっかりと行の末尾に記載されています。これなら小学校の先生に怒られることがありません。

原稿用紙

2ページ目

原稿用紙

マクロの解説

仕組みは単純です。

原稿用紙に収るように文字間隔を一定にして句点を行末に記載する設定をします。

この設定方法のために、西上原裕明さんの以下の書籍のP.442 「市販の原稿用紙に合わせて文書を作る」を参考にしました。

これが、「原稿用紙の設定」部分です。

これだけだと罫線が見えません。上記の設定は、あくまでも文字の配置を変更するだけだからです。

罫線は、ヘッダーにオートシェイプの線を書き込みます。そうすれば、どのページでも罫線が表示されますし、文字入力の邪魔になりません。

これが、「罫線を引く準備」と「原稿用紙の罫線を引く（ヘッダーに描画）」の部分です。

オートシェイプの線の位置を計算して書き込んでいるだけです。

なお、1ページの行数や1行あたりの文字数の設定は16行目、17行目でします。

マクロ


Sub 原稿用紙のグリッド線を引く()

　Dim myDoc As Document
　Dim i As Integer
　Dim myGridDistHoriz As Single
　Dim myGridDistVert As Single
　Dim myLenHoriz As Single
　Dim myLenVert As Single
　Dim myBeginX As Single
　Dim myEndX As Single
　Dim myBeginY As Single
　Dim myEndY As Single
　Dim myY As Single
　Dim myX As Single

　Const myCharsLine As Integer = 28　'1行の文字数
　Const myLinesPage As Integer = 40　'1ページの行数
　
　Application.ScreenUpdating = False

　'-------------------------------------------
　'原稿用紙の設定
　'-------------------------------------------
　Set myDoc = ActiveDocument

　With myDoc

　　'縦書き
　　.Content.Orientation = wdTextOrientationVerticalFarEast

　　With .PageSetup
　　　'文字数など
　　　.LayoutMode = wdLayoutModeGenko　'原稿用紙の設定にする
　　　.CharsLine = myCharsLine　'行の文字数
　　　.LinesPage = myLinesPage　'ページの行数
　　　.Orientation = wdOrientLandscape　'用紙を横向き
　　End With

　　'段落の設定
　　With .Range.ParagraphFormat
　　　'［句読点のぶら下げ処理を行う］をオン（行の末尾に1文字分追加）
　　　.HangingPunctuation = True
　　　'［1ページの行数を指定時に文字を行グリッド線に合わせる］をオン
　　　.DisableLineHeightGrid = False
　　End With
　　
　　'文字の設定
　　'［［ページ設定］で指定した1行の文字数を使用する］をオン
　　.Range.Font.DisableCharacterSpaceGrid = False
　　
　End With


　'-------------------------------------------
　'罫線を引く準備
　'-------------------------------------------
　With myDoc.PageSetup

　　'罫線の開始位置、終了位置を特定
　　myBeginX = .LeftMargin
　　myEndX = .PageWidth - .RightMargin
　　myBeginY = .TopMargin
　　myEndY = .PageHeight - .BottomMargin

　　'罫線の長さを特定
　　myLenHoriz = .PageWidth - .LeftMargin - .RightMargin
　　myLenVert = .PageHeight - .TopMargin - .BottomMargin

　　myGridDistHoriz = myLenHoriz / myLinesPage
　　myGridDistVert = myLenVert / myCharsLine

　End With


　'-------------------------------------------
　'原稿用紙の罫線を引く（ヘッダーに描画）
　'-------------------------------------------
　With myDoc.Sections(1).Headers(wdHeaderFooterPrimary)

　　'横の罫線
　　For i = 0 To myCharsLine
　　　myY = myBeginY + i * myGridDistVert
　　 .Shapes.AddLine myBeginX, myY, myEndX, myY
　　Next i
　　DoEvents

　　'縦の罫線
　　For i = 0 To myLinesPage
　　　myX = myBeginX + i * myGridDistHoriz
　　　.Shapes.AddLine myX, myBeginY, myX, myEndY
　　Next i
　　DoEvents

　End With


　Set myDoc = Nothing
　Application.ScreenUpdating = True

End Sub

-コード
-, , ,