【Word VBA】鱗文様描画マクロ▽ソースコード

Option Explicit

Option Base 0

Public Sub 鱗文様描画マクロ()

    Const SCLPLEFT = 80　　　　　　         '描画開始位置Ｘ

    Const SCLPTOPP = 100　　　　　　      '　　　　　　Ｙ

    Const SCLPLENG = 30　　　　　　        '三角形一辺長さ

    Const SCLPCOLS = 14　　　　　　        '描画列数

    Const SCLPROWS = 6 　　　　 　　　　'描画行数

    '

    Const SCLPLNWE = 0.75                     '線の太さ

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

    Dim Ip As Integer, Jp As Integer

    Dim intHei As Integer, blnUpp As Boolean

    Dim intLft As Integer, intTop As Integer

    Dim lngCol(2) As Long

    '

    lngCol(0) = RGB(0, 191, 255)　　　'←塗りつぶし色1

    lngCol(1) = RGB(135, 206, 250)　　'←塗りつぶし色2

    lngCol(2) = vbWhite　　　　　　  　'←線色

　　'

    intHei = CInt(SCLPLENG / 2 * Sqr(3))　　'←三角形高さ

    For Jp = 0 To SCLPROWS - 1

        intTop = SCLPTOPP + intHei * Jp

        For Ip = 0 To SCLPCOLS - 1

            intLft = SCLPLEFT + (SCLPLENG / 2) * Ip

            '

            blnUpp = IIf(((Jp + Ip) Mod 2) = 0, True, False)

            '*三角形描画

            With ActiveDocument.Shapes.AddShape( _

               msoShapeIsoscelesTriangle, _

                        intLft, intTop, SCLPLENG, intHei)

              .Fill.Visible = True                 '←塗りつぶし

              .Fill.ForeColor.RGB = lngCol(IIf(blnUpp = True, 0, 1))

              .Line.Visible = True　　　　　'←線

              .Line.ForeColor.RGB = lngCol(2)

              .Line.Weight = SCLPLNWE

              .Rotation = IIf(blnUpp = True, 0, 180)　　'←回転

            End With

        Next Ip

    Next Jp

End Sub