【Word VBA】提灯描画マクロ▽ソースコード
記事IT・テクノロジー
Option Explicit
Option Base 0
'
Public Sub 提灯描画マクロ()
Const PLNTLEFT = 90 '描画開始位置Ｘ
Const PLNTTOPP = 80 ' Ｙ
'
Const PLNTSWID = 30 '描画(火袋)幅
Const PLNTSHEI = 30 '描画(火袋)高さ
'
Const PLNTRWID = 20 '描画(塗輪)幅
Const PLNTRHEI = 6 '描画(塗輪)高さ
Const PLNTVSPC = 10 '横-間隔
Const PLNTHSPC = 20 '縦-間隔
Const PLNTCOLS = 5 '横/描画数
Const PLNTROWS = 4 '縦/描画数
'
Const PLNTLNWE = 0.5 '線の太さ
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim intDxp As Integer, intDyp As Integer
Dim intWxp As Integer, lngCol(3) As Long
'
lngCol(0) = vbYellow '←提灯の色
lngCol(1) = RGB(255, 105, 180)
lngCol(2) = RGB(0, 191, 255)
lngCol(3) = vbMagenta
'
For Jp = 0 To PLNTROWS - 1
intDyp = PLNTTOPP + (PLNTSHEI + PLNTHSPC) * Jp
For Ip = 0 To PLNTCOLS - 1 - (Jp Mod 2)
intDxp = PLNTLEFT + (PLNTSWID + PLNTVSPC) * Ip _
+ ((PLNTSWID + PLNTVSPC) / 2) * (Jp Mod 2)
'*火袋描画
With ActiveDocument.Shapes.AddShape( _
msoShapeFlowchartTerminator, _
intDxp, intDyp, PLNTSWID, PLNTSHEI)
.Fill.Visible = msoTrue
.Fill.Patterned msoPatternHorizontal
.Fill.BackColor.RGB = lngCol((Jp * PLNTCOLS + Ip) Mod 4)
.Fill.ForeColor.RGB = vbBlack
.Line.Visible = msoTrue
.Line.ForeColor.RGB = vbBlack
.Line.Weight = PLNTLNWE
End With
'
intWxp = intDxp + (PLNTSWID - PLNTRWID) / 2
'*塗輪(上)描画
With ActiveDocument.Shapes.AddShape( _
msoShapeRectangle, _
intWxp, intDyp - PLNTRHEI, _
PLNTRWID, PLNTRHEI)
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = vbBlack
.Line.Visible = msoFalse
End With
'*塗輪(下)描画
With ActiveDocument.Shapes.AddShape( _
msoShapeRectangle, _
intWxp, intDyp + PLNTSHEI, _
PLNTRWID, PLNTRHEI)
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = vbBlack
.Line.Visible = msoFalse
End With
Next Ip
Next Jp
End Sub
