オートシェイプでうずまきを描くには?

パワーポイントなどのオートシェイプで、うずまきを描く方法を教えてください。
かなり雑であってもかまいません。

よろしくおねがいします。

No.7 ベストアンサー 回答者： CoalTar 回答日時： 2009/03/27 16:19

ExcelでA列連番、B列角度、C列-X、D列-Y

C2セル =$A2*COS($B2/180*PI())
D2セル =$A2*SIN($B2/180*PI())
下へオートフィル

C,D列のみ範囲選択してグラフウィザード
データポイントを平滑線でつないだマーカーなしの散布図
　グラフタイトル、軸、目盛線、凡例を消す
プロットエリアの背景をクリア

グラフをコピーしてPowerPointに貼り付け
参考まで

この回答へのお礼

なさんのご協力で集合知の威力を実感しました。
助かりました。
ありがとうございます。

お礼日時：2009/03/28 11:15

No.6 回答者： DOUGLAS_ 回答日時： 2009/03/27 15:36

[回答番号：No.3・5] の DOUGLAS_ です。

　たびたび申し訳ございません。

　[回答番号：No.5] の マクロでは渦の数が解りませんね。

　　　　Sin((i - 1) * PI / ii * 10) * i * YY / ii + XX, _
　　　　Cos((i - 1) * PI / ii * 10) * i * YY / ii + YY

の部分を

　　　　Sin(i * PI / 6) * i * YY / ii + XX, _
　　　　Cos(i * PI / 6) * i * YY / ii + YY

になさってください。

　今回の修正で、
＞ii = 60 '曲線の頂点の数
の部分の数値を大きくすると渦の数が増え、ここで指定した頂点の数の約１２分の１が渦の数になります（詳しいことを書くと混乱されるかも知れませんので省略いたします）。

この回答へのお礼

なさんのご協力で集合知の威力を実感しました。
助かりました。
ありがとうございます。

お礼日時：2009/03/28 11:16

No.5 回答者： DOUGLAS_ 回答日時： 2009/03/27 15:00

[回答番号：No.3] の DOUGLAS_ です。

　koko88okok さんの [回答番号：No.4] のアイデアを拝借して、「曲線」で描いてみました。

　[回答番号：No.3] と同じ方法で、コードだけ下記に差し替えて試行なさってみてください。

＞ii = 60 '曲線の頂点の数
の部分の数値を大きくすると螺旋の精度が上がりますが、60ぐらいで十分だと存じます。

Sub Macro2()
　Dim XX As Single, YY As Single
　Dim i As Integer, ii As Integer, PI As Single
　XX = ActiveWindow.Width / 2 '中心のＸ座標
　YY = ActiveWindow.Height / 2 '中心のＹ座標
　PI = 3.14159265358979
　ii = 60 '曲線の頂点の数
　
　With ActiveWindow.Selection.SlideRange.Shapes. _
　　BuildFreeform(msoEditingAuto, XX, YY)
　　For i = 1 To ii
　　　.AddNodes msoSegmentCurve, msoEditingAuto, _
　　　　Sin((i - 1) * PI / ii * 10) * i * YY / ii + XX, _
　　　　Cos((i - 1) * PI / ii * 10) * i * YY / ii + YY
　　Next
　　　.ConvertToShape.Select
　End With
End Sub

　なお、前回答の Macro1 の場合
For i = 1 To 10
の右端の数値で渦の数を指定します。
　最終的にオートシェイプをグループ化しておりますので、「うずまき」を [右クリック] - [オブジェクトの書式設定(F)] で、線の太さや色を指定なさってください。

No.4 回答者： koko88okok 回答日時： 2009/03/27 13:27

正確な螺旋でなくてもよいなら、下記のような方法でも螺旋を描くことができます。

オートシェイプで何個かの同心円と中心円を通る45度～30度の直線をグループ化しておいて、「曲線」を螺旋状にクリックしながら描画します。

歪になった曲線は「頂点の編集」で、修正します。
添付図は頂点の編集を行っている途中です。

この回答へのお礼

なさんのご協力で集合知の威力を実感しました。
助かりました。
ありがとうございます。

お礼日時：2009/03/28 11:16

No.3 回答者： DOUGLAS_ 回答日時： 2009/03/27 12:22

１）新しいスライドを挿入します。

２）PowerPoint で [Alt] + [F11] で ＶＢＥ（Visual Basic Editor） を開きます。
３）ＶＢＥ で、[挿入(I)] - [標準モジュール(M)] で現れる コードウィンドウ に下記のコードをコピペし、[F5] キーを１回だけ押下します。
４）ＶＢＥ の左ペインにある、[VBAProjet（プレゼンテーション１）] - [標準モジュール] - [Module1] を右クリック [Module1 の解放(R)] をクリックします。
５）「削除する前に Module1 エクスポートしますか?」に [いいえ(N)] をクリックします。
６）[Alt] + [F4] で ＶＢＥ を閉じます。
７）これで、(１)のスライド上に渦巻きができました。

Sub Macro1()
　Dim i As Single
　ActiveWindow.Selection.SlideRange.Shapes.SelectAll
　ActiveWindow.Selection.ShapeRange.Delete
　With ActiveWindow.Selection
　　For i = 1 To 10
　　　.SlideRange.Shapes.AddShape(msoShapeArc, _
　　　　100 + (i Mod 2) * 10, 100 - i * 10, i * 10, i * 10).Select
　　　.ShapeRange.Adjustments(1) = (i Mod 2) * 180
　　　.ShapeRange.Adjustments(2) = (1 - i Mod 2) * 180
　　Next
　End With
　ActiveWindow.Selection.SlideRange.Shapes.SelectAll
　ActiveWindow.Selection.ShapeRange.Group
End Sub

No.2 回答者： ASIMOV 回答日時： 2009/03/27 11:51

エクセルならこんな感じで出来ますが．．．

（パワポは持ってないので）

Sub uzumaki()
' うずの設定
　　kei = 10#: keiadd = 5#: px = 200#: py = 200#
　　uzu = 5: sensyu = 2
'
　　Do
　　　　ActiveSheet.Shapes.AddShape(msoShapeArc, px, py, kei, kei).Select
　　　　Selection.ShapeRange.Line.Weight = sensyu
　　　　Selection.ShapeRange.Adjustments.Item(2) = -90#
　　　　kei = kei + keiadd
　　　　ActiveSheet.Shapes.AddShape(msoShapeArc, px - kei, py, kei, kei).Select
　　　　Selection.ShapeRange.Line.Weight = sensyu
　　　　Selection.ShapeRange.Adjustments.Item(2) = -90#
　　　　Selection.ShapeRange.IncrementRotation 180#
　　　　kei = kei + keiadd
　　　　py = py - keiadd * 2
　　　　uzu = uzu - 1
　　Loop While uzu
End Sub

この回答へのお礼

みなさんのご協力で集合知の威力を実感しました。
助かりました。
ありがとうございます。

お礼日時：2009/03/28 11:15

No.1 回答者： kokorone 回答日時： 2009/03/27 10:26

まずは、こののサイトで、”渦巻き”で検索してみてください。

同類のＱ＆Ａがでてきます。