【Word VBA】三角形模様描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub 三角形模様描画マクロ()

    Const TANGLEFT = 110　　　　   '描画開始位置Ｘ

    Const TANGTOPP = 100　　        '　　　　　　Ｙ

    '

    Const TANGOSIZ = 40　　　       '外側三角形サイズ

    Const TANGISIZ = 20 　　 　　　'内側三角形サイズ

    Const TANGCREV = 1.5              '内側三角形補正

    '

    Const TANGCOLS = 10               '横/描画数

    Const TANGROWS = 6               '縦/描画数

    '

    Const TANGLNWE = 1.5            '線の太さ

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

    Dim Ip As Integer, Jp As Integer

    Dim intDxp As Integer, intDyp As Integer

    Dim intDht(1) As Integer, BlnUpD As Boolean

    Dim lngCol(2) As Long, sngHpW As Single

    '

    lngCol(0) = RGB(184, 134, 11)         '←線色(外側三角形

    lngCol(1) = RGB(218, 165, 32)         '←線色(内側三角形

    lngCol(2) = RGB(245, 222, 179)       '←塗りつぶし色

    sngHpW = Sqr(3) / 2                       '辺と高さ比

    '

    intDht(0) = TANGOSIZ * sngHpW     '三角形の高さ

    intDht(1) = TANGISIZ * sngHpW

    '

    For Jp = 0 To TANGROWS - 1

        intDyp = TANGTOPP + intDht(0) * Jp

        For Ip = 0 To TANGCOLS - 1

            intDxp = TANGLEFT + (TANGOSIZ / 2) * Ip

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

            '*外側三角形描画

With ActiveDocument.Shapes.AddShape(msoShapeIsoscelesTriangle, _

                 intDxp - TANGOSIZ / 2, _

                 intDyp - intDht(0) * (2 / 3), _

                 TANGOSIZ, intDht(0))

                .Fill.Visible = msoFalse

                .Line.Visible = msoTrue

                .Line.ForeColor.RGB = lngCol(0)

                .Line.Weight = TANGLNWE

                If BlnUpD = False Then .Flip msoFlipVertical

           End With

            '*内側三角形描画

 With ActiveDocument.Shapes.AddShape(msoShapeIsoscelesTriangle, _

                intDxp - TANGISIZ / 2, _

                 intDyp - intDht(1) * (2 / 3) _

               * IIf(BlnUpD = True, 1, TANGCREV), _

                 TANGISIZ, intDht(1))

                .Fill.Visible = msoTrue

                .Fill.ForeColor.RGB = lngCol(2)

                .Line.Visible = msoTrue

                .Line.ForeColor.RGB = lngCol(1)

                .Line.Weight = TANGLNWE

                If BlnUpD = False Then .Flip msoFlipVertical

           End With

        Next Ip

    Next Jp

End Sub