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

Option Explicit

Option Base 0

'

Public Sub 菱菊描画マクロ()

    Const DCHRCXPS = 200　　　　　　    '菊の中心位置　X

    Const DCHRCYPS = 180 　　　　　　　' Y

    '

    Const DCHRHLNG = 120　　　　　　   '花びらの長さ(長い方)

    Const DCHRVLNG = 80 　　　　　　　 '花びらの長さ(短い方)

    '

    Const DCHRSRAD = 18                       '中央円の半径

    '

    Const DCHRLNWN = 2                       '描画線の太さ

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

    Dim Ip As Integer, Jp As Integer

    Dim Kp As Integer, lngCol As Long

    Dim sngRnd As Single, sngAng(1) As Single

    Dim intExp As Integer, intEyp As Integer

    Dim intErd As Integer, intDps(11, 1) As Integer

    '

    '

    lngCol = RGB(148, 0, 211) '←線色

    '*花びら位置の取得

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

    For Ip = 0 To 2

        sngAng(0) = ((Ip * 2 + 1) * 15) * sngRnd

        'ひし形輪郭と放射線との交点把握

        intExp = DCHRVLNG / (Tan(sngAng(0))  _

                 + (DCHRVLNG / DCHRHLNG))

        intEyp = Tan(sngAng(0)) * intExp

        For Jp = 1 To 4

             Select Case Jp

                    Case 1: Kp = Ip

                    Case 2: Kp = 11 - Ip

                    Case 3: Kp = 6 + Ip

                    Case 4: Kp = 5 - Ip

             End Select

             '*右回りに位置データ格納

             intDps(Kp, 0) = DCHRCXPS + intExp * Choose(Jp, 1, 1, -1, -1)

             intDps(Kp, 1) = DCHRCYPS + intEyp * Choose(Jp, 1, -1, -1, 1)

        Next Jp

    Next Ip

    '

    For Ip = 0 To 11

        '*花びら直線部分、描画

        With ActiveDocument.Shapes.AddLine( _

             DCHRCXPS, DCHRCYPS, intDps(Ip, 0), intDps(Ip, 1)).Line

            .ForeColor.RGB = lngCol               '←線色

            .Weight = DCHRLNWN                 '←線の太さ

        End With

        '

        '*花びら円弧、描画角算出

        If Ip = 0 Then Jp = 11 Else Jp = Ip - 1

        '中心、半径

        intExp = (intDps(Ip, 0) + intDps(Jp, 0)) / 2

        intEyp = (intDps(Ip, 1) + intDps(Jp, 1)) / 2

        intErd = CInt(Sqr((intDps(Ip, 0) - intExp) ^ 2 _

                        + (intDps(Ip, 1) - intEyp) ^ 2))

        '描画角

        If (intDps(Ip, 0) - intExp) <> 0 Then

            sngAng(0) = Atn((intEyp - intDps(Ip, 1)) _

                      / (intExp - intDps(Ip, 0))) / sngRnd

        Else

            sngAng(0) = 90

        End If

        If (intDps(Jp, 0) - intExp) <> 0 Then

            sngAng(1) = Atn((intEyp - intDps(Jp, 1)) _

                      / (intExp - intDps(Jp, 0))) / sngRnd

        Else

            sngAng(1) = 90

        End If

         '*花びら円弧部分、描画

        With ActiveDocument.Shapes.AddShape(msoShapeArc, _

               intExp - intErd, intEyp - intErd, _

               intErd * 2, intErd * 2)

             .Fill.Visible = msoFalse

             .Line.ForeColor = lngCol              '←線色

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

            .Adjustments(1) = sngAng(0) _

                           + IIf(Ip >= 1 And Ip <= 6, 0, -180)

            .Adjustments(2) = sngAng(1) _

                           + IIf(Ip >= 1 And Ip <= 6, 180, 0)

         End With

     Next Ip

     '*真ん中の円を描画

     With ActiveDocument.Shapes.AddShape(msoShapeOval, _

          DCHRCXPS - DCHRSRAD, DCHRCYPS - DCHRSRAD, _

          DCHRSRAD * 2, DCHRSRAD * 2)

             .Fill.Visible = msoTrue

             .Fill.ForeColor = vbWhite

             .Line.ForeColor = lngCol             '←線色

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

    End With

End Sub