【Word VBA】雷紋模様描画マクロ▽ソースコード

記事
IT・テクノロジー
HC220809A.png

Option Explicit
Option Base 0
'
Public Sub 雷紋模様描画マクロ()
    Const THUNLEFT = 100         '描画開始位置X
    Const THUNTOPP = 80          '        Y  
    Const THUNMAGN = 2               '描画倍率
    Const THUNCOLS = 3                            '横描画数
    Const THUNROWS = 5                           '縦描画数
    '---------------------------------------------------------------------------
    Dim Ip As Integer, Jp As Integer
    Dim Kp As Integer
    Dim intDxp As Integer, intDyp As Integer
    Dim varPos As Variant, lngCol As Long
    Dim sngBas() As Single, sngDat() As Single
    '
    varPos = Array(7, 7, 8, 7, 8, 5, 5, 5, 5, 9, 10, 9, _
                  10, 3, 3, 3, 3, 11, 12, 11, 12, 1, 1, _
                  1, 1, 13, 14, 13, 14, 1, 27, 1, 27, 13, _
                  16, 13, 16, 3, 25, 3, 25, 11, 18, 11, _
                  18, 5, 23, 5, 23, 9, 20, 9, 20, 7, 21, 7)
    '
    lngCol = vbRed '←線色
    Ip = (UBound(varPos, 1) - 1) \ 2
    ReDim sngBas(Ip, 1), sngDat(Ip, 1)
    '*ポリラインデータ設定
    For Ip = LBound(varPos, 1) To UBound(varPos, 1) Step 2
        sngBas(Ip \ 2, 0) = CSng(varPos(Ip + 0)) * THUNMAGN
        sngBas(Ip \ 2, 1) = CSng(varPos(Ip + 1)) * THUNMAGN
    Next Ip
    '
    For Jp = 0 To THUNROWS - 1
        intDyp = THUNTOPP + 14 * THUNMAGN * Jp
        For Ip = 0 To THUNCOLS - 1
            intDxp = THUNLEFT + 28 * THUNMAGN * Ip
            '*描画位置設定
            For Kp = LBound(sngBas, 1) To UBound(sngBas, 1)
                sngDat(Kp, 0) = sngBas(Kp, 0) + intDxp
                sngDat(Kp, 1) = sngBas(Kp, 1) + intDyp
            Next Kp
            '*ポリライン描画
            With ActiveDocument.Shapes.AddPolyline(sngDat)
                .Fill.Visible = msoFalse
                .Line.ForeColor = lngCol '←線色
                .Line.Weight = THUNMAGN '←線の太さ
                .Line.DashStyle = msoLineSolid '←線種
                If (Jp Mod 2) = 1 Then
                   .Flip msoFlipVertical
                End If
            End With
      Next Ip
  Next Jp
End Sub

サービス数40万件のスキルマーケット、あなたにぴったりのサービスを探す