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

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

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

先生の赤ペンの通りに文字を書いているつもりが、いつのまにか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

トップへ戻る