【Word VBA】雲立涌文様描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub 雲立涌文様描画マクロ()

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

    Const CLTWTOPP = 80                   '　　　　　　Ｙ

    '

    Const CLTWUNIT = 40                   '波線周期長さ

    Const CLTWAMPL = 20                  '波線周期振れ

    Const CLTWYDVT = 3                    '振れ位置補正

    '

    Const CLTWBETW = 30                 '波線間隔

    Const CLTWCLWD = 16                 '雲の幅

    '

    Const CLTWCOLS = 7                   '横描画数

    Const CLTWROWS = 5                  '縦描画数

    '

    Const CLTWLNW1 = 2                  '波線の太さ

    Const CLTWLNW2 = 1.5               '雲の線の太さ

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

    Dim Ip As Integer, Jp As Integer

    Dim Kp As Integer, lngCol As Long

    Dim intDxp, intDyp As Integer

    Dim sngBez(3, 1) As Single

    '

    '

    lngCol = RGB(70, 130, 180) '←線色

    For Ip = 0 To CLTWCOLS - 1

        intDxp = CLTWLEFT + CLTWBETW * Ip

        For Jp = 0 To CLTWROWS - 1

            intDyp = CLTWTOPP + CLTWUNIT * Jp - 2

            '*波線のベジエ曲線データ作成

            For Kp = 0 To 3

                sngBez(Kp, 1) = intDyp _

                 + (CLTWUNIT \ 3) * Kp _

                 + Choose(Kp + 1, 0, CLTWYDVT, 0 - CLTWYDVT, 0)

                If (Ip Mod 2) = 0 Then          '奇数桁

                   sngBez(Kp, 0) = intDxp _

                 + Choose(Kp + 1, 0, CLTWAMPL, 0 - CLTWAMPL, 0)

                Else                                     '偶数桁

                   sngBez(Kp, 0) = intDxp _

                 + Choose(Kp + 1, 0, 0 - CLTWAMPL, CLTWAMPL, 0)

                End If

            Next Kp

            '*波線描画

            With ActiveDocument.Shapes.AddCurve(sngBez)

                .Fill.Visible = msoFalse

                .Line.ForeColor.RGB = lngCol

                .Line.Weight = CLTWLNW1

            End With

            '*雲描画

            If Ip < CLTWCOLS - 1 Then

               With ActiveDocument.Shapes.AddShape( _

                    msoShapeCloud, _

                 intDxp + CLTWBETW / 2 - CLTWCLWD / 2, _

                 intDyp + (CLTWUNIT / 2) _

                        * ((Ip + 1) Mod 2), _

                 CLTWCLWD, CLTWUNIT / 2)

                .Fill.Visible = msoFalse

                .Line.ForeColor.RGB = lngCol

                .Line.Weight = CLTWLNW2

               End With

            End If

        Next Jp

    Next Ip

End Sub