Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

59239 / 76738

←次へ　｜　前へ→


	【22206】Re:三角形の頂点の座標は？

ｂｙｋｉｎ - 05/2/11(金) 14:31 -


	引用なし

	パスワード

こんにちわ。

きれいなグラフィックやねー
面白そうやったんで、作ってみました。直線やのうてフリーフォーム使ってます。

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使って、動きを滑らかにしてます。
三角形の状態を元に戻すコードも追加しました。

試してみてな。
ほな。

1 hits

▼

【22204】三角形の頂点の座標は？ ponpon 05/2/11(金) 12:46