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

Option Explicit

Option Base 0

Public Sub 分銅文様描画マクロ()

    Const WEIGLEFT = 100                '描画開始位置Ｘ

    Const WEIGTOPP = 90                 '　　　　　　Ｙ

    Const WEIGLRAD = 30                 'サイズ

    '

    Const WEIGROWS = 5                 '描画数(縦)

    Const WEIGCOLS = 12                '描画数(横)

    '

    Const WEIGLNWE = 2                 '描画線の太さ

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

    Dim Ip As Integer, Jp As Integer

    Dim Kp As Integer, lngCol As Long

    Dim intCxp As Integer, intCyp As Integer

    '

    lngCol = RGB(0, 139, 139)           '←線色

    For Jp = 0 To WEIGROWS - 1

        For Ip = 0 To WEIGCOLS - 1

            intCyp = WEIGTOPP + (WEIGLRAD) * Jp _

                                           - (WEIGLRAD / 2) * (Ip Mod 2)

            intCxp = WEIGLEFT + (WEIGLRAD / 2) * Ip

            For Kp = 0 To 1

                '円弧描画

                With ActiveDocument.Shapes.AddShape(msoShapeArc, _

                    intCxp, intCyp, WEIGLRAD, WEIGLRAD)

                    .Fill.Visible = False

                    .Line.Visible = True

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

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

                    .Adjustments(1) = 180 * Kp + 0 _

                                             + IIf(((Ip + 0) Mod 2) = 0, 0, 90)

                    .Adjustments(2) = 180 * Kp + 90 _

                                             + IIf(((Ip + 0) Mod 2) = 0, 0, 90)

                End With

            Next Kp

        Next Ip

    Next Jp

End Sub