【Word VBA】算盤縞模様描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub 算盤縞模様描画マクロ()

    Const ABACLEFT = 90 　　　　'描画開始位置Ｘ

    Const ABACTOPP = 80　　　   '　　　　　　Ｙ

    '

    Const ABACBWID = 8　　　    '描画幅(棒)

    Const ABACSWID = 24 　　　 '描画幅(ひし形)

    Const ABACSHEI = 18            '描画高さ(ひし形)

    '

    Const ABACVSP1 = 4             '横-間隔１

    Const ABACVSP2 = 4             '横-間隔２

    Const ABACVSPC = (ABACBWID + ABACVSP1 _

          + ABACSWID + ABACVSP2)

    Const ABACHSP1 = 4             '縦-間隔

    Const ABACHSPC = (ABACSHEI + ABACHSP1)

    Const ABACCOLS = 7            '横/描画数

    Const ABACROWS = 8           '縦/描画数

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

    Dim Ip As Integer, Jp As Integer

    Dim intDxp As Integer, intDyp As Integer

    Dim lngCol As Long

    '

    lngCol = RGB(160, 82, 45)            '←描画色

    For Ip = 0 To ABACCOLS - 1

        intDxp = ABACLEFT + ABACVSPC * Ip

        '*棒描画

        With ActiveDocument.Shapes.AddShape( _

             msoShapeRectangle, _

             intDxp, ABACTOPP, _

             ABACBWID, _

             ABACHSPC * ABACROWS - ABACHSP1)

            .Fill.Visible = msoTrue

            .Fill.ForeColor.RGB = lngCol

            .Line.Visible = msoFalse

       End With

       For Jp = 0 To ABACROWS - 1

             intDyp = ABACTOPP + ABACHSPC * Jp

             '*ひし形描画

             With ActiveDocument.Shapes.AddShape( _

                  msoShapeDiamond, _

                  intDxp + ABACBWID + ABACVSP1, _

                  intDyp, ABACSWID, ABACSHEI)

                 .Fill.Visible = msoTrue

                 .Fill.ForeColor.RGB = lngCol

                 .Line.Visible = msoFalse

            End With

        Next Jp

    Next Ip

End Sub