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

Option Explicit

Option Base 0

'

Public Sub 蚊絣文様描画マクロ()

    Const MOKCANLF = 90                         'キャンバス位置Ｘ

    Const MOKCANTP = 80                         '                     Ｙ

    Const MOKCANWD = 300                     'キャンバス幅

    Const MOKCANHT = 200                      'キャンバス高さ

    '

    Const MOKALEFT = 10                         '蚊絣描画開始位置Ｘ

    Const MOKATOPP = 15                        '　　　　　　　　Ｙ

    Const MOKASIZE = 30                         '十字サイズ

    Const MOKAHZSP = 20                        '水平間隔

    Const MOKAVTSP = 60                        '垂直間隔

    '

    Const MOKACOLS = 5                         '横 描画数

    Const MOKAROWS = 8                       '縦 描画数

    '

    Const MOKASHPS = 0.05                   '十字の鋭さ

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

    Dim Ip As Integer, Jp As Integer

    Dim intDxp As Integer, intDyp As Integer

    Dim shpCan As Shape

    '

    '*キャンバス設定

    Set shpCan = _

    ActiveDocument.Shapes.AddCanvas( _

                   MOKCANLF, MOKCANTP, MOKCANWD, MOKCANHT)

    shpCan.Fill.Visible = msoTrue

    shpCan.Fill.ForeColor = RGB(0, 0, 139)       '←キャンバス背景色

    '

    For Jp = 0 To MOKAROWS - 1

        intDyp = MOKATOPP + MOKAHZSP * Jp

        For Ip = 0 To MOKACOLS - 1

            If (Jp Mod 2) = 0 Or Ip < MOKACOLS - 1 Then

               intDxp = MOKALEFT + MOKAVTSP * Ip  _

                                            + (MOKAVTSP / 2) * (Jp Mod 2)

               '*十字描画

               With shpCan.CanvasItems.AddShape( _

                  msoShape4pointStar, intDxp, intDyp, _

                                                 MOKASIZE, MOKASIZE)

                   .Fill.ForeColor = vbWhite　　　　　'←塗りつぶし色

                   .Line.Visible = msoFalse

                  .Adjustments(1) = MOKASHPS

               End With

            End If

        Next Ip

    Next Jp

End Sub