「写経」用教材を作成する(Word)

WordVBA VBA一般

「写経」用教材（？）を作成する

Wordの「原稿用紙設定」機能

『一太郎』では、「文書スタイル呼び出し」（？）という機能で、コクヨ社の原稿用紙の書式を呼び出すことができる。んで、印刷するときに「升目を印刷する」というチェックボックスにチェックを入れると、まるでモノホンの原稿用紙に印字したかのごとく、プリントアウトすることができる。

Wordの場合、

f:id:akashi_keirin:20181020192727j:plain

このように、「ページ レイアウト」というタブに「原稿用紙設定」というやつがある。

コイツをクリックしてやると、

f:id:akashi_keirin:20181020192737j:plain

こんなウインドウが開くので、画像のように「スタイル」というドロップダウンリストで「マス目付き原稿用紙」を選ぶ。

で、[ＯＫ]をクリックしてやると、ややあって画面の表示が切り替わる。

Before

f:id:akashi_keirin:20181020192746j:plain

トンボの位置を見ていただければおわかりのように、余白を極端に狭くしている。（画像の場合、上下左右全て10mmで、とじしろは0mm。）理由はよくわからないが、こうしておかないと、「原稿用紙設定」完了後に行位置が激しくズレータになる。

After

f:id:akashi_keirin:20181020192800j:plain

このように、キレイに原稿用紙に文字列が収まっている。句読点のぶら下げも完璧。

「『写経』用教材」とは

要するに、文章を原稿用紙に書き写すための教材。最近、文章を書き写す、というのが割と（色んな意味で）効果的だなーと思うことが多かったので、市販の書き写し教材みたいなのを簡単に自作できないかなあと思ったのがきっかけ。

もちろん、単純に原稿用紙に書き写せばいいのだけれど、句読点なんかがあらかじめ印字されていれば、写し間違いなんかに早期に気付きやすいかな、と。

また、改段落で字下げされているところなんかは間違いやすそうだから、文の先頭も印字しておけばやりやすいかな、と思って、次のようなスペックを考えた。

  • 句読点や引用符等の記号の類いは印字する（＝黒字にする）。
  • 文頭以外の普通の文字は印字しない（＝白字にする）。

原則はこれだけ。

使用するメソッド類

これまでに紹介してきたメソッドを使う。

isSignメソッド

akashi-keirin.hatenablog.com

で作成。引数で渡された文字列が記号か文字かを判定する。

getFirstCharPositionメソッド

akashi-keirin.hatenablog.com

で作成。引数で渡されたRangeオブジェクトのうち、初めて普通の文字が出てくるのが何文字目かを返す。

changeFontColorメソッド

akashi-keirin.hatenablog.com

で作成。普通の文字か、記号かによって、フォントの色を変える。

コード

リスト１　標準モジュール
Private Sub changeColorFirstCharOfSentence( _
              ByVal targetSentences As Sentences)    '……(1)'
  Dim targetSentence As Range    '……(2)'
  For Each targetSentence In targetSentences    '……(3)'
    Dim startPosition As Long
    startPosition = getFirstCharPosition(targetSentence)    '……(4)'
    With targetSentence
      If startPosition = .Characters.Count Then Exit Sub    '……(5)'
      Dim i As Long
      For i = startPosition + 1 To .Characters.Count    '……(6)'
        Call changeFontColor(.Characters(i).Font)
      Next
    End With
  Next
End Sub

まず、(1)の

Private Sub changeColorFirstCharOfSentence( _
              ByVal targetSentences As Sentences)

では、引数をSentences型にしている。Sentencesコレクションを受け取って、その要素（つまり、各文）をこのメソッド内で処理してしまおうと考えた。

(2)の

Dim targetSentence As Range

では、次のFor Each ～ Nextで回すためにRange型の変数を用意。Sentencesコレクションの要素がRangeオブジェクトなので、こんなふうになる。

(3)からの11行

For Each targetSentence In targetSentences
  Dim startPosition As Long
  startPosition = getFirstCharPosition(targetSentence)    '……(4)'
  With targetSentence
    If startPosition = .Characters.Count Then Exit Sub    '……(5)'
    Dim i As Long
    For i = startPosition + 1 To .Characters.Count    '……(6)'
      Call changeFontColor(.Characters(i).Font)
    Next
  End With
Next

では、For Each ～ Nextで、引数として受け取ったtargetSentences、つまりSentencesコレクションの各要素を取り出して、順に処理をする。

まず、(4)の

startPosition = getFirstCharPosition(targetSentence)

では、自作のgetFirstCharPositionメソッド（下記のリスト２参照。）を用いて、対象の文の何文字目に初めて普通の文字が出てくるのかを取得し、変数startPositionにぶち込んでいる。

(5)の

If startPosition = .Characters.Count Then Exit Sub

はガード節。文の中で初めて普通の文字が表れる位置と文の文字数が一致している場合（たとえば、「『――あみたいな場合。ちょっと異常だが。）には、何もする必要がない（＝白字に変える必要がない）ので、処理を抜ける。

ただし、このガード節は、基本的には文字数0のSentencesコレクションを想定している。文字数0なら何もする必要がないので。

(5)のガード節をくぐり抜けた場合は、処理に移る。ここからが本番。

(6)からの３行

For i = startPosition + 1 To .Characters.Count
  Call changeFontColor(.Characters(i).Font)
Next

では、対象の文の、初めて普通の文字が出てきた位置の次の位置（１文字目は印字したいので。）から最後までループして、それぞれ自作のchangeFontColorメソッド（下記のリスト４参照。）を用いて、それぞれの文字（正確にはFontオブジェクト）について黒字／白字を設定している。

説明はこれでおしまい。以下に処理の中で呼び出される各メソッドのコードを参考に載っけておく。

【参考】リスト２　標準モジュール
Private Function getFirstCharPosition( _
                   ByVal targetSentence As Range) As Long
  Dim ret As Long
  ret = 0
  Dim i As Long
  With targetSentence
    For i = 1 To .Characters.Count
      If Not isSign(.Characters(i)) Then ret = i: Exit For
    Next
    getFirstCharPosition = ret
  End With
End Function
【参考】リスト３　標準モジュール
Private Function isSign( _
                   ByVal targetCharacter As String) As Boolean
  isSign = False
  Dim str As String
  str = "、 。 ， ． ・ ： ； ？ ！ "
  str = str & "゛ ゜ ´ ｀ ¨ ＾ ￣ ＿ 〇 "
  str = str & "― ‐ ／ ＼ ～ ∥ ｜ … ‥ "
  str = str & "‘ ’ （ ） 〔 〕 ［ "
  str = str & "］ ｛ ｝ 〈 〉 《 》 「 」 "
  str = str & "『 』 【 】  ° ′ ″ "
  str = str & "! "" ' ( ) , - . / : ; ?"
  str = str & " " & Chr(&H8167) & " " & Chr(&H8168)
  Dim ar As Variant
  ar = Split(str)
  Dim i As Long
  For i = LBound(ar) To UBound(ar)
    If targetCharacter = ar(i) Then isSign = True: Exit Function
  Next
End Function
【参考】リスト４　標準モジュール
Private Sub changeFontColor(ByVal targetFont As Font)
  If isSign(targetFont.Parent.Text) Then _
    targetFont.ColorIndex = wdBlack: Exit Sub
  targetFont.ColorIndex = wdWhite
End Sub

使ってみる

f:id:akashi_keirin:20181020192841j:plain

この状態で、次のコードを実行。

リスト５　標準モジュール
Public Sub convertDocumentForTrainingPerSentence()
  Call changeColorFirstCharOfSentence(ThisDocument.Sentences)
End Sub

f:id:akashi_keirin:20181020193147j:plain

この通り。

ちなみに、上から５行目のカギ括弧の中の先頭の文字が白字になっているのは、直前の

「策に依ってはだが……？」

の直前が改段落ではなく、改行になっている上、特に文末であることを示す記号もつかわれていないせいだと思う。改段落なら、こんなことをしている間に、長安を潰滅してみせます」で一つのRangeオブジェクトと認識されるので、次の「策に依ってはだが……？」も一つのRangeオブジェクトと認識されるのだと思います。

f:id:akashi_keirin:20181020192813j:plain

おわりに

各文の先頭を印字するのがうるさいようなら、SentencesオブジェクトのところをParagraphsに変えて、段落先頭のみ印字、ということもできます。