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

Option Explicit

Option Base 0

'

Public Sub 芝翫縞文様描画マクロ()

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

    Const SIKATOPP = 80　　　　　      '　　　　　　Ｙ

    Const SIKACWSZ = 15　　　　        '円弧の大きさ

    Const SIKACHSZ = 25　　　　         '円弧の大きさ

    Const SIKACIOV = 0.4　　　　　     '円弧の重なり

    '

    Const SIKALNWE = 1.5 　　　　　　'線の太さ

    '

    Const SIKAVLGP = 3　　　　　        '縦線の間隔

    Const SIKAVLSP = (SIKALNWE + SIKAVLGP)

    Const SIKAVSPC = (SIKAVLSP * 4)

    Const SIKAVSPM = (SIKAVSPC + SIKAVLGP * 2)

    '

    Const SIKAROWS = 6　　　　          '縦の描画数

    Const SIKACOLS = 5 　　　　　　　 '横の描画数

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

    Dim Ip As Integer, Jp As Integer

    Dim Kp As Integer, lngCol As Long

    Dim intXpt As Integer, intYpt As Integer

    '

    lngCol = RGB(255, 99, 71)            '←線色(トマト色)

    For Ip = 0 To SIKACOLS - 1

        intXpt = SIKALEFT + (SIKACWSZ + SIKAVSPM) * Ip

        For Jp = 0 To SIKAROWS - 1

             intYpt = SIKATOPP + SIKACHSZ \ 2 _

                   + SIKACHSZ * (2 - SIKACIOV * 2) * Jp

             '*円弧を２つ描画

             For Kp = 0 To 1

                 With ActiveDocument.Shapes.AddShape(msoShapeArc, _

                      (intXpt + SIKAVLGP) - SIKACWSZ \ 2, _

                      intYpt - SIKACHSZ \ 2 _

                            + (SIKACHSZ * (1 - SIKACIOV)) * Kp, _

                          SIKACWSZ, SIKACHSZ)

                     .Fill.Visible = False

                     .Line.Visible = True

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

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

                     '↓円弧描画角度

                     .Adjustments(1) = IIf(Kp = 0, -105, 85)

                     .Adjustments(2) = IIf(Kp = 0, 105, 285)

                 End With

             Next Kp

        Next Jp

        '*左側の線を描画

        For Kp = 0 To 3

           With ActiveDocument.Shapes.AddLine( _

                 intXpt - SIKACWSZ \ 2 - SIKAVLGP - SIKAVLSP * Kp, _

                 SIKATOPP, _

                 intXpt - SIKACWSZ \ 2 - SIKAVLGP _

                     - SIKAVLSP * Kp, _

                 SIKATOPP + SIKACHSZ * (2 - SIKACIOV * 2) * SIKAROWS _

                 + SIKACHSZ * SIKACIOV).Line

                .ForeColor.RGB = lngCol               '←線色

                .Weight = SIKALNWE                   '←線の太さ

           End With

        Next Kp

    Next Ip

End Sub