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

Option Explicit

Option Base 0

Public Sub 入子菱文様描画マクロ()

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

    Const RHOMTOPP = 100                    '　　　　　　Ｙ

    Const RHOMLENG = 40                      'ひし形長い対角線長さ

    Const RHOMCOLS = 6                        '列数

    Const RHOMROWS = 7                      '行数

    '

    Const RHOMLNW1 = 2                       '線の太さ(外側)

    Const RHOMLNW2 = 1                       '線の太さ(内側)

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

    Dim Ip As Integer, Jp As Integer, Kp As Integer

    Dim intWid As Integer, intHei As Integer

    Dim intDxp As Integer, intDyp As Integer

    Dim lngCol(1) As Long

    lngCol(0) = vbWhite '←塗りつぶし色

    lngCol(1) = vbBlue '←線色

    '

    intWid = RHOMLENG

    intHei = CInt(RHOMLENG * 0.618) '*黄金比

    '

    For Jp = 0 To RHOMROWS - 1

        intDyp = RHOMTOPP + (intHei / 2) * Jp

        For Ip = 0 To RHOMCOLS - 1

            intDxp = RHOMLEFT + intWid * Ip  _

                       + IIf((Jp Mod 2) = 0, 0, intWid / 2)

            For Kp = 0 To 3

             With ActiveDocument.Shapes.AddShape(msoShapeDiamond, _

                 intDxp + (intWid / 8) * Kp, intDyp + (intHei / 8) * Kp, _

                 intWid - (intWid / 4) * Kp, intHei - (intHei / 4) * Kp)

                    .Fill.Visible = True

                    .Fill.ForeColor.RGB = lngCol(0)

                    .Line.Visible = True

                    .Line.ForeColor.RGB = lngCol(1)

                    .Line.Weight = IIf(Kp = 0, RHOMLNW1, RHOMLNW2)

                End With

            Next Kp

        Next Ip

    Next Jp

End Sub