英語４本線入りワークシート作成 Word VBA

Wordで英語を勉強し始めた子供用に４本線つきの練習問題を作った話

環境 Windows10、Office2010

まず、4本線付きのフォントを探したが、あまり良いのがない。
Windows10に無料でついてくる教科書フォント（HGS教科書フォント font size 48）にあう罫線を作ってみることにした。

注）英語の練習用４本線は等幅ではない（教科書フォントは5:9:5）

#罫線をつくる

試行錯誤してとりあえず、私の環境では以下のコードでちょうど合うようになった

注）後で大文字が合わないことに気が付き、いろいろ探したところ、正進社のエイゴラボフォント（個人利用で無料でダウンロードできる）がうまくいくことが分かった。ただ、比率が3:4:3なので数字を変更する必要がある。
正進社エイゴラボフォント用のコード参照

以下のWordのVBA

Sub Fourline()


  Num = 9

  For i = 1 To Num

　  With Selection

      .InsertAfter Text:=" "
      .Font.Underline = none
      .Font.Name = "HGS教科書体"
      .Font.NameAscii = "HGS教科書体"
      .Font.Size = 48
      .Collapse Direction:=wdCollapseEnd
      
      x = 70
      y = .Information(wdVerticalPositionRelativeToPage) + 20


      With ActiveDocument.Shapes.AddLine(x - 50, y, x + 500, y)
        .Line.DashStyle = 4
        .Line.Weight = 0.5
        .Line.ForeColor.RGB = RGB(0, 0, 0)
        l1 = .Name
      End With

      With ActiveDocument.Shapes.AddLine(x - 50, y + 11.5, x + 500, y + 11.5)
        .Line.DashStyle = 4
        .Line.Weight = 0.5
        .Line.ForeColor.RGB = RGB(0, 0, 0)
        l2 = .Name
      End With

      With ActiveDocument.Shapes.AddLine(x - 50, y + 11.5 + 20.7, x + 500, y + 11.5 + 20.7)
        .Line.Weight = 0.5
        .Line.ForeColor.RGB = RGB(0, 0, 0)
        l3 = .Name
      End With

      With ActiveDocument.Shapes.AddLine(x - 50, y + 11.5 + 20.7 + 11.5, x + 500, y + 11.5 + 20.7 + 11.5)
        .Line.DashStyle = 4
        .Line.Weight = 0.5
        .Line.ForeColor.RGB = RGB(0, 0, 0)
        l4 = .Name
      End With

      l5 = ActiveDocument.Shapes.Range(Array(l1, l2, l3, l4)).Group.Name

      ActiveDocument.Shapes(l5).RelativeVerticalPosition = 1
      
      If i <> Num Then .InsertAfter Text:=vbCr
        .Collapse Direction:=wdCollapseEnd

    End With
  Next i

  ActiveDocument.Shapes.SelectAll
  l10 = Selection.ShapeRange.Group.Name

End Sub

#罫線を「透かし」に入れ、Wordテンプレートをつくる

このままだと、練習問題を作るたびに、線を引かないといけないし、文字を入力するごとに罫線も移動してしまうので、「透かし」にいれて背景にする。

「透かし」の作り方

罫線を選択して、
（ページレイアウト）ー（透かし）ー（選択範囲を透かしギャラリーに保存する）
を選ぶとダイアローグボックスが出てくるので名前を付けて保存。

もう一度、
（ページレイアウト）ー（透かし）
を選ぶと今、保存した、透かしが出てくるので選択すると、透かし（背景）として罫線がでる、
最初の罫線は削除して、テンプレートとして保存で出来上がり。

#正進社エイゴラボフォント用のコード

フォントサイズを変える場合はmとy_sftを調整してほしい

アルファベットをいれると、こんな感じ

Sub Fourline_eigorabo()


  Num = 7

  m = 5.1
  y_sft = 21

  For i = 1 To Num

    With Selection

      .InsertAfter Text:=" "
      .Font.Underline = none
      .Font.Name = "エイゴラボ R"
      .Font.NameAscii = "エイゴラボ R"
      .Font.Size = 48
      .Collapse Direction:=wdCollapseEnd

      x = 70
      y = .Information(wdVerticalPositionRelativeToPage) + y_sft


      With ActiveDocument.Shapes.AddLine(x - 50, y, x + 500, y)
        .Line.DashStyle = 4
        .Line.Weight = 0.5
        .Line.ForeColor.RGB = RGB(0, 0, 0)
        l1 = .Name
      End With

      With ActiveDocument.Shapes.AddLine(x - 50, y + 3 * m, x + 500, y + 3 * m)
        .Line.DashStyle = 4
        .Line.Weight = 0.5
        .Line.ForeColor.RGB = RGB(0, 0, 0)
        l2 = .Name
      End With

      With ActiveDocument.Shapes.AddLine(x - 50, y + (3 + 4) * m, x + 500, y + (3 + 4) * m)
        .Line.Weight = 0.5
        .Line.ForeColor.RGB = RGB(0, 0, 0)
        l3 = .Name
      End With

      With ActiveDocument.Shapes.AddLine(x - 50, y + (3 + 4 + 3) * m, x + 500, y + (3 + 4 + 3) * m)
        .Line.DashStyle = 4
        .Line.Weight = 0.5
        .Line.ForeColor.RGB = RGB(0, 0, 0)
        l4 = .Name
      End With

      l5 = ActiveDocument.Shapes.Range(Array(l1, l2, l3, l4)).Group.Name

      ActiveDocument.Shapes(l5).RelativeVerticalPosition = 1

      If i <> Num Then .InsertAfter Text:=vbCr
        .Collapse Direction:=wdCollapseEnd

    End With
  Next i

  ActiveDocument.Shapes.SelectAll
  l10 = Selection.ShapeRange.Group.Name

End Sub