【Word VBA】虹描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub 虹描画マクロ()

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

    Const RNBWTOPP = 80 　　  '　　　　　　Ｙ

    '

    Const RNBWIRAD = 20         '内側の半径

    Const RNBWRDSP = 3          '色の間隔幅

    '横-間隔

    Const RNBWVPIT = _

          (RNBWIRAD + RNBWRDSP * 7) * 2 + 5

    '縦-間隔

    Const RNBWHPIT = _

          (RNBWIRAD + RNBWRDSP * 7) * 1 + 5

    Const RNBWCOLS = 4          '横/描画数

    Const RNBWROWS = 4         '縦/描画数

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

    Dim Ip As Integer, Jp As Integer

    Dim Kp As Integer

    Dim intDxp As Integer, intDyp As Integer

    Dim intRnd As Integer, lngCol(6) As Long

    '

    '*虹の色を指定（内側→→外側）/紫-青-水色-緑-黄色-オレンジ-赤

    lngCol(0) = RGB(148, 0, 211): lngCol(1) = RGB(30, 144, 255)

    lngCol(2) = RGB(0, 255, 255): lngCol(3) = RGB(0, 128, 0)

    lngCol(4) = RGB(255, 255, 0): lngCol(5) = RGB(255, 165, 0)

    lngCol(6) = RGB(255, 0, 0)

    '

    For Jp = 0 To RNBWROWS - 1

        intDyp = RNBWTOPP + RNBWHPIT * Jp + RNBWHPIT

        For Ip = 0 To RNBWCOLS - IIf((Jp Mod 2) = 0, 1, 2)

            intDxp = RNBWLEFT + RNBWVPIT * Ip _

                   + (RNBWVPIT / 2) * ((Jp Mod 2) + 1)

            '

            For Kp = 0 To 6

                intRnd = RNBWIRAD + RNBWRDSP * Kp

             With ActiveDocument.Shapes.AddShape(msoShapeBlockArc, _

                     intDxp - intRnd, intDyp - intRnd, _

                     intRnd * 2, intRnd * 2)

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

                    .Fill.ForeColor.RGB = lngCol(Kp)

                    .Line.Visible = False

                    .Adjustments(1) = -180 '←描角度

                    .Adjustments(2) = -0

                    .Adjustments(3) = 0.5 - ((intRnd - RNBWRDSP) _

                                              / intRnd) / 2

               End With

            Next Kp

        Next Ip

    Next Jp

End Sub