【Word VBA】風鈴描画マクロ▽ソースコード

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

Option Explicit
Option Base 0
Public Sub 風鈴描画マクロ()
    Const WIBLLEFT = 100   '描画開始位X
    Const WIBLTOPP = 80    '_____Y
    Const WINBUPLN = 30    '吊るす紐の長さ
    Const WINBBWID = 70    '本体幅
    Const WINBBHEI = 45    '本体高さ
    '
    Const WINBHWID = 25    '本体底穴幅
    Const WINBHHEI = 10    '本体底穴高さ
    Const WINBHPOS = 32    '本体底穴位置
    '
    Const WINBWWID = 6    '本体中の錘幅
    Const WINBWHEI = 4    '本体中の錘高さ
    Const WINBWPOS = 33    '本体中の錘位置
    '
    Const WINBDWLN = 30    '本体と短冊長さ
    '
    Const WINBTWID = 40    '短冊幅
    Const WINBTHEI = 80    '短冊長さ
    Const WINBTWAV = 0.2   '短冊うねり
    '
    Const WINBCONT = 3    '描画数
    Const WINBSPAC = 15    '横間隔
    Const WINBLNWE = 1    '輪郭太さ
    '---------------------------------------------------------------------------
    Dim Ip As Integer
    Dim intDxp As Integer, intDyp As Integer
    Dim lngclOl As Long
    '
    lngclOl = vbBlack '←線色
    For Ip = 0 To WINBCONT - 1
        intDxp = WIBLLEFT + (WINBBWID + WINBSPAC) * Ip _
                                     + WINBBWID \ 2
        intDyp = WIBLTOPP
        With ActiveDocument.Shapes.AddLine(intDxp, intDyp, _
                      intDxp, intDyp + WINBUPLN).Line
            .ForeColor.RGB = lngclOl
            .Weight = WINBLNWE
       End With
       intDyp = intDyp + WINBUPLN
       With ActiveDocument.Shapes.AddShape(msoShapeOval, _
                      intDxp - WINBBWID \ 2, intDyp, _
                 WINBBWID, WINBBHEI)
            .Fill.ForeColor.RGB = _
            Choose((Ip Mod 3) + 1, vbCyan, vbGreen, vbYellow)
            .Line.ForeColor.RGB = lngclOl
            .Line.Weight = WINBLNWE
       End With
       With ActiveDocument.Shapes.AddShape(msoShapeOval, _
                 intDxp - WINBHWID \ 2, intDyp + WINBHPOS, _
                 WINBHWID, WINBHHEI)
            .Fill.ForeColor.RGB = RGB(105, 105, 105)
            .Line.ForeColor.RGB = lngclOl
            .Line.Weight = WINBLNWE
       End With
       With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _
                 intDxp - WINBWWID \ 2, intDyp + WINBWPOS, _
                 WINBWWID, WINBWHEI)
           .Fill.ForeColor.RGB = RGB(255, 165, 0)
           .Line.ForeColor.RGB = lngclOl
           .Line.Weight = WINBLNWE
       End With
       '
       intDyp = intDyp + WINBWPOS
       With ActiveDocument.Shapes.AddLine(intDxp, intDyp, _
                      intDxp, intDyp + WINBDWLN).Line
           .ForeColor.RGB = lngclOl
           .Weight = WINBLNWE
       End With
       '
       intDyp = intDyp + WINBDWLN
       With ActiveDocument.Shapes.AddShape(msoShapeWave, _
          intDxp - WINBTHEI \ 2, _
          intDyp + WINBTHEI \ 2 - WINBTWID \ 2,  _
                                                WINBTHEI, WINBTWID)
           .Fill.ForeColor.RGB = _
            Choose((Ip Mod 3) + 1, vbGreen, vbYellow, vbCyan)
           .Line.ForeColor.RGB = lngclOl
           .Adjustments(1) = WINBTWAV
           .Rotation = 90
       End With
    Next Ip
End Sub

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