【Word VBA】心臓形放射状線描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub 心臓形放射状線描画マクロ()

    Const HTSHCNXP = 120　　　　     '描画中心位置Ｘ

    Const HTSHCNYP = 175 　　　　　 '　　　　　　Ｙ

    '

    Const HTSHANSP = 5                     '描画刻み角度

    Const HPSHRATE = 75                   '線の長さレート

    Const HTSPLNWE = 1                    '線の太さ

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

    Dim Ip As Integer

    Dim sngSit As Single, sngRnd As Single

    Dim intDxp As Integer, intDyp As Integer

    Dim lngCol As Long

    '

    lngCol = RGB(255, 69, 0)                              '←線色

    For Ip = 0 To 360 - 1 Step HTSHANSP

        sngSit = (Atn(1) / 45) * Ip

        sngRnd = Cos(sngSit) + 1

        intDxp = (sngRnd * Cos(sngSit)) _

                 * HPSHRATE + HTSHCNXP

        intDyp = (sngRnd * Sin(sngSit)) _

                 * HPSHRATE + HTSHCNYP

        '*直線描画

        With ActiveDocument.Shapes.AddLine( _

              HTSHCNXP, HTSHCNYP, intDxp, intDyp).Line

            .ForeColor.RGB = lngCol                        '←線色

            .Weight = HTSPLNWE                           '←線の太さ

        End With

    Next Ip

End Sub