|
こんにちわ。
きれいなグラフィックやねー
面白そうやったんで、作ってみました。直線やのうてフリーフォーム使ってます。
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Triangle As Shape
Sub 三角形の描画()
With ActiveSheet.Shapes
.AddLine 200, 200, 400, 200
With .BuildFreeform(msoEditingAuto, 200, 200)
.AddNodes msoSegmentLine, msoEditingAuto, 340, 100
.AddNodes msoSegmentLine, msoEditingAuto, 400, 200
.AddNodes msoSegmentLine, msoEditingAuto, 200, 200
Set Triangle = .ConvertToShape
End With
With Triangle
.Fill.Visible = msoFalse
.Fill.ForeColor.RGB = vbRed
.Line.DashStyle = msoLineDash
End With
DoEvents
Sleep 1000
.AddLine(50, 200, 600, 200).Line.DashStyle = msoLineDashDot
.AddLine(50, 100, 600, 100).Line.DashStyle = msoLineDashDot
End With
End Sub
Sub 頂点の移動()
Dim i As Long
With Triangle
With .Nodes
For i = 5 To 250 Step 2
.SetPosition 2, 340 + i, 100
DoEvents
Sleep 100
Next
End With
.Fill.Visible = msoTrue
.Line.DashStyle = msoLineSolid
End With
End Sub
Sub 頂点を元に戻す()
With Triangle
.Nodes.SetPosition 2, 340, 100
.Fill.Visible = msoFalse
.Line.DashStyle = msoLineDash
End With
DoEvents
End Sub
Sub 図の削除()
On Error Resume Next
ActiveSheet.Lines.Delete
Triangle.Delete
Set Triangle = Nothing
End Sub
APIのSleep使って、動きを滑らかにしてます。
三角形の状態を元に戻すコードも追加しました。
試してみてな。
ほな。
|
|