【Word　VBA】クロスステッチ描画マクロ▽ソースコード

記事

IT・テクノロジー

Option Explicit

Option Base 0

Const CONSTPAI As Double = 3.14159265358979 'π

Const STCHSXPT As Integer = 300 '描画開始位置Ｘ

Const STCHSYPT As Integer = 150 '　　　　　　Ｙ

Const STCHLENG As Integer = 5 '辺の長さ

Const STCHORDR As Integer = 3 '次数

Const STCHLNCL As Long = &H4763FF '線の色(Tomoto)

Const STCHLNWT As Single = 1 '線の太さ

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

Public p_intDxp As Integer '描画位置Ｘ(変数)

Public p_intDyp As Integer '　　　　Ｙ(変数)

Public p_intAng As Integer '描画角度　(変数)

'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

Public Sub クロスステッチ描画マクロ()

Dim Ip As Integer

p_intDxp = STCHSXPT: p_intDyp = STCHSYPT

p_intAng = 0

For Ip = 1 To 4

Call クロスステッチ描画マクロ_回帰(STCHORDR)

p_intAng = p_intAng + 90

Next Ip

End Sub

'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

Public Sub クロスステッチ描画マクロ_回帰(pintNum As Integer)

Dim intExp As Integer, intEyp As Integer

Dim dblRad As Double

If pintNum = 0 Then

dblRad = p_intAng * CONSTPAI / 180

intExp = p_intDxp - STCHLENG * Cos(dblRad)

intEyp = p_intDyp + STCHLENG * Sin(dblRad)

With ActiveDocument.Shapes.AddLine( _

p_intDxp, p_intDyp, intExp, intEyp).Line

.ForeColor.RGB = STCHLNCL '←線色

.Weight = STCHLNWT '←線の太さ

End With

p_intDxp = intExp: p_intDyp = intEyp

'↓時間がかかるので、挿入しました。

DoEvents

Else