【Word VBA】工字繋ぎ文様描画マクロ其の二▽ソースコード

Option Explicit

Option Base 0

'

Public Sub 工字繋ぎ文様描画マクロ2()

    Const KOJILEFT = 150           '描画開始位置Ｘ

    Const KOJITOPP = 100          '　　　　　　Ｙ

    '

    Const KOJIPRAT = 5              'ポリライン描画倍率

    '

    Const KOJICOLS = 6             '横描画数

    Const KOJIROWS = 5           '縦描画数

    Const KOJICXP1 = 0             '横連結ポイント

    Const KOJICXP2 = 6

    Const KOJICYP1 = 5             '縦連結ポイント

    Const KOJICYP2 = 17

    '

    Const KOJILNWE = 1.5        '線の太さ

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

    Dim Ip As Integer, Jp As Integer

    Dim Kp As Integer, lngColr(1) As Long

    Dim intDxp As Integer, intDyp As Integer

    Dim varPoly As Variant

    Dim sngPBas() As Single, sngPDat() As Single

    Dim intRPos(KOJIROWS - 1, 1) As Integer

    '

    '*ポリラインデータ

    varPoly = Array(-0.71, -0.54, 1.1, -1.97, -0.31, -3.08, -1.22, _

    -2.38, -2.64, -3.46, -0.83, -4.89, 6.24, 0.65, 4.43, 2.05, 3.02, _

    0.97, 3.93, 0.24, 2.52, -0.86, -1.1, 1.97, 0.31, 3.08, 1.22, 2.38, _

    2.64, 3.46, 0.83, 4.89, -2.71, 2.11, -6.24, -0.65, -4.43, -2.05, _

    -3.02, -0.97, -3.93, -0.24, -2.52, 0.86, -0.71, -0.54)

    '*ポリラインデータ設定

    ReDim sngPBas((UBound(varPoly, 1) - 1) \ 2, 1)

    ReDim sngPDat((UBound(varPoly, 1) - 1) \ 2, 1)

    For Kp = LBound(varPoly, 1) To UBound(varPoly, 1) Step 2

        sngPBas(Kp \ 2, 0) = CSng(varPoly(Kp + 0)) * KOJIPRAT

        sngPBas(Kp \ 2, 1) = CSng(varPoly(Kp + 1)) * KOJIPRAT

    Next Kp '

    '

    '*左端位置を取得

    intDxp = KOJILEFT - CInt(sngPBas(17, 0))

    intDyp = KOJITOPP - CInt(sngPBas(5, 0))

    For Jp = 0 To KOJIROWS - 1

        intRPos(Jp, 0) = intDxp

        intRPos(Jp, 1) = intDyp

        intDxp = intDxp + CInt(sngPBas(KOJICYP2, 0)  _

                 - sngPBas(KOJICYP1, 0))

        intDyp = intDyp + CInt(sngPBas(KOJICYP2, 1)  _

                - sngPBas(KOJICYP1, 1))

    Next Jp

    '

    lngColr(0) = RGB(72, 209, 204)          '←塗りつぶし色

    lngColr(1) = vbBlue                            '←線色

    For Jp = 0 To KOJIROWS - 1

        intDxp = intRPos(Jp, 0) '左端位置セット

        intDyp = intRPos(Jp, 1)

        For Ip = 0 To KOJICOLS - 1

            'ポリライン描画位置設定

            For Kp = LBound(sngPDat, 1) To UBound(sngPDat, 1)

                sngPDat(Kp, 0) = sngPBas(Kp, 0) + intDxp

                sngPDat(Kp, 1) = sngPBas(Kp, 1) + intDyp

            Next Kp

            'ポリライン描画

            With ActiveDocument.Shapes.AddPolyline(sngPDat)

                .Fill.Visible = msoTrue

                .Fill.ForeColor = lngColr(0)       '←塗りつぶし色

                .Line.Visible = msoTrue

                .Line.ForeColor = lngColr(1)     '←線色

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

            End With

            '*次描画中心位置

            intDxp = CInt(sngPDat(KOJICXP2, 0) - sngPBas(KOJICXP1, 0))

            intDyp = CInt(sngPDat(KOJICXP2, 1) - sngPBas(KOJICXP1, 1))

        Next Ip

    Next Jp

End Sub

蛇足

　ポリラインのデータは、自作のツールで作成したが、そのツール、VisualStudio2022になって、作り直した。