【Word VBA】席次表作成マクロ▽ソースコード

Option Explicit

Option Base 0

Public Sub 席次表作成マクロ()

    Const SEATXCNT = 4 '横方向席数

    Const SEATYCNT = 3 '縦方向席数

    '

    Const TBOXWIDT = 80 'テキストボックス幅

    Const TBOXHEIG = 30 'テキストボックス高

    '

    Const TBOXXGAP = 10 'テキストボックス横方向間隔

    Const TBOXYGAP = 10 'テキストボックス縦方向間隔

    '

    Const TBOXLEFT = 80 'テキストボックス描画開始位置

    Const TBOXTOP = 100 '

    '---------------------------------------------------------------------------

    Dim Ip As Integer, Jp As Integer

    Dim varName As Variant

    '

    '//名前設定(松尾芭蕉+蕉門１０哲+小林一茶)

    varName = Array("松尾芭蕉", "宝井其角", "服部嵐雪", "向井去来",　_

                              "内藤丈草", "森川許六",  "杉山杉風", "各務支考",  _

                              "立花北枝", "志太野坡", "越智越人", "小林一茶")

    '

    For Jp = 0 To SEATYCNT - 1

        For Ip = 0 To SEATXCNT - 1

              With ActiveDocument.Shapes.AddTextbox(　_

                     msoTextOrientationHorizontal, _

                     TBOXLEFT + (TBOXWIDT + TBOXXGAP) * Ip,  _

                     TBOXTOP + (TBOXHEIG + TBOXYGAP) * Jp,  _

                     TBOXWIDT, TBOXHEIG)

                    '

                    .Line.Visible = True                        '枠線(False:枠無し)

                    .Line.ForeColor.RGB = RGB(0, 0, 0) '枠線色

                    .Line.Weight = 1.5 '枠線太さ

                   'フォント

                   .TextFrame.TextRange.Font.Name = "ＭＳ ゴシック" 

                   .TextFrame.TextRange.Font.Size = 12 

                   '文字位置 

                   .TextFrame.TextRange.Paragraphs.Alignment =  _

                                                        wdAlignParagraphCenter

                  '名前

                  If Jp * SEATXCNT + Ip <= UBound(varName, 1) Then

                    .TextFrame.TextRange.Text = varName(Jp*SEATXCNT+Ip)

                 Else

                    .TextFrame.TextRange.Text = ""

                 End If

            End With

        Next Ip

    Next Jp

End Sub

   Const SEATXCNT = 5 '横方向席数

   Const SEATYCNT = 3 '縦方向席数

                    .Line.Visible = False   '枠線(False:枠無し)