【Word VBA】半円組合せ模様描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub 半円組合せ模様描画マクロ()

    Const SMCRCTRX = 220         '描画開始位置Ｘ

    Const SMCRCTRY = 210         '　　　　　　Ｙ

    Const SMCRRADI = 120         '描画半径

    '

    Const SMCRFICL = &H9314FF          '描画色(DeepPink)

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

   Dim Ip As Integer

   Dim intSxp(2) As Integer, intSyp(2) As Integer

   Dim intSan As Integer

   '

   '

   For Ip = 0 To 3

       Select Case Ip

              Case 0: intSxp(0) = SMCRCTRX - SMCRRADI / 2

                      intSyp(0) = SMCRCTRY - SMCRRADI

                      intSxp(1) = SMCRCTRX - SMCRRADI / 4

                      intSyp(1) = SMCRCTRY - SMCRRADI

                      intSxp(2) = SMCRCTRX - SMCRRADI / 4

                      intSyp(2) = SMCRCTRY - SMCRRADI / 2

                      intSan = -90

              Case 1: intSxp(0) = SMCRCTRX

                      intSyp(0) = SMCRCTRY - SMCRRADI / 2

                      intSxp(1) = SMCRCTRX + SMCRRADI / 2

                      intSyp(1) = SMCRCTRY - SMCRRADI / 4

                      intSxp(2) = SMCRCTRX

                      intSan = 0

                      intSyp(2) = SMCRCTRY - SMCRRADI / 4

              Case 2: intSxp(0) = SMCRCTRX - SMCRRADI / 2

                      intSyp(0) = SMCRCTRY

                      intSxp(1) = SMCRCTRX - SMCRRADI / 4

                      intSyp(1) = SMCRCTRY + SMCRRADI / 2

                      intSxp(2) = SMCRCTRX - SMCRRADI / 4

                      intSyp(2) = SMCRCTRY

                      intSan = 90

              Case 3: intSxp(0) = SMCRCTRX - SMCRRADI

                      intSyp(0) = SMCRCTRY - SMCRRADI / 2

                      intSxp(1) = SMCRCTRX - SMCRRADI / 1

                      intSyp(1) = SMCRCTRY - SMCRRADI / 4

                      intSxp(2) = SMCRCTRX - SMCRRADI / 2

                      intSyp(2) = SMCRCTRY - SMCRRADI / 4

                      intSan = 180

       End Select

       '*半円１描画

       With ActiveDocument.Shapes.AddShape(msoShapePie, _

                 intSxp(0), intSyp(0), SMCRRADI, SMCRRADI)

                .Fill.Visible = True:

                .Fill.ForeColor.RGB = SMCRFICL

                .Line.Visible = False

               .Adjustments(1) = intSan

               .Adjustments(2) = intSan + 180

       End With

       '*半円２描画（凸）

       With ActiveDocument.Shapes.AddShape(msoShapePie, _

                 intSxp(1), intSyp(1), SMCRRADI / 2, SMCRRADI / 2)

                .Fill.Visible = True:

                .Fill.ForeColor.RGB = SMCRFICL

                .Line.Visible = False

               .Adjustments(1) = intSan + 180

               .Adjustments(2) = intSan + 360

       End With

       '*半円３描画（凹）

       With ActiveDocument.Shapes.AddShape(msoShapePie, _

                 intSxp(2), intSyp(2), SMCRRADI / 2, SMCRRADI / 2)

                .Fill.Visible = True:

                .Fill.ForeColor.RGB = vbWhite

                .Line.Visible = False

               .Adjustments(1) = intSan

               .Adjustments(2) = intSan + 180

       End With

   Next Ip

End Sub