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

Option Explicit

Option Base 0

'

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

    Const SHRKLEFT = 120　　　　        '描画開始位置Ｘ

    Const SHRKTOPP = 135　　　　       '　　　　　　Ｙ

    '

    Const SHRKFRAD = 10 　　　　　　'扇半径間隔

    Const SHRKCONT = 5 　　　　　　 '扇半径数

    Const SHRKSWID = SHRKFRAD * SHRKCONT  '描画幅

    Const SHRKSHEI = (SHRKSWID - 5)               '描画高さ

    Const SHRKCOLS = 5                    '横/描画数

    Const SHRKROWS = 4                   '縦/描画数

    '

    Const SHRKLNWE = 3                   '線の太さ

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

    Dim Ip As Integer, Jp As Integer

    Dim Kp As Integer, lngCol As Long

    Dim intDxp As Integer, intDyp As Integer

    Dim intRad As Integer, sngSit As Single

    Dim sngRnd As Single, sngAng As Single

    '

    lngCol = RGB(47, 79, 79)                '←線色

    '

    sngRnd = (4 * Atn(1)) / 180

    For Jp = 0 To SHRKROWS - 1

        For Ip = 0 To SHRKCOLS - 1

            intDyp = SHRKTOPP + (SHRKSHEI) * Jp _

                   + (SHRKSHEI \ 2) * (Ip Mod 2)

            intDxp = SHRKLEFT + (SHRKSWID + 2) * Ip

            '

            For Kp = 1 To SHRKCONT - 1

                intRad = SHRKFRAD * (Kp + 1) '←半径

                '*描画円弧角度計算

                sngAng = (90 / SHRKCONT) _

                       * (Kp + 1) * sngRnd

                sngSit = Atn(SHRKSWID * Sin(sngAng) _

                / (SHRKSWID - SHRKSWID * Cos(sngAng))) / sngRnd

                '*円弧描画

                With ActiveDocument.Shapes.AddShape( _

                     msoShapeArc, _

                    intDxp - intRad, intDyp - intRad, _

                    intRad * 2, intRad * 2)

                   .Fill.Visible = msoFalse

                   .Line.ForeColor.RGB = lngCol              '←線色

                   .Line.Weight = SHRKLNWE                 '←線の太さ

                   .Line.DashStyle = msoLineRoundDot   '←点線指定

                   '↓描画角

                   .Adjustments(1) = -90 - (90 - sngSit)

                   .Adjustments(2) = -90 + (90 - sngSit)

              End With

           Next Kp

        Next Ip

    Next Jp

End Sub