Option Explicit
Option Base 0
Public Sub 矢絣文様描画マクロ()
Const ARKALEFT = 120 '描画開始位置Ｘ
Const ARKATOPP = 100 ' Ｙ
Const ARKAAWID = 30 '矢幅
Const ARKAAHEI = ARKAAWID * 1.5 '矢羽長さ
Const ARKABWID = 2 '棒の太さ
Const ARKACOLS = 7 '横描画数
Const ARKAROWS = 4 '縦描画数
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim intDxp As Integer, intDyp As Integer
Dim lngCol As Long, blnCol As Boolean
'
lngCol = RGB(186, 85, 211) '←描画色
For Jp = 0 To ARKAROWS - 1
intDyp = ARKATOPP + ARKAAHEI * Jp
For Ip = 0 To ARKACOLS - 1
intDxp = ARKATOPP + ARKAAWID * Ip
blnCol = IIf(((Ip + Jp) Mod 2) = 0, True, False)
'*矢の部分描画
With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _
intDxp, intDyp, ARKAAWID, ARKAAHEI)
.Fill.ForeColor.RGB = IIf(blnCol = True, lngCol, vbWhite)
.Line.ForeColor.RGB = .Fill.ForeColor.RGB
End With
With ActiveDocument.Shapes.AddShape(msoShapeIsoscelesTriangle, _
intDxp, intDyp, ARKAAWID, ARKAAWID \ 2)
.Fill.ForeColor.RGB = IIf(blnCol = False, lngCol, vbWhite)
.Line.ForeColor.RGB = .Fill.ForeColor.RGB
.Flip msoFlipVertical
End With
'*棒の部分描画
With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _
intDxp + (ARKAAWID - ARKABWID) \ 2, intDyp, ARKABWID, _
ARKAAWID \ 2)
.Fill.ForeColor.RGB = IIf(blnCol = True, lngCol, vbWhite)
.Line.ForeColor.RGB = .Fill.ForeColor.RGB
End With
With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _
intDxp + (ARKAAWID - ARKABWID) \ 2, intDyp + ARKAAWID \ 2, _
ARKABWID, ARKAAHEI - ARKAAWID \ 2)
.Fill.ForeColor.RGB = IIf(blnCol = False, lngCol, vbWhite)
.Line.ForeColor.RGB = .Fill.ForeColor.RGB
End With
Next Ip
Next Jp
End Sub
