オンライン健康相談、gooドクター

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

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

gooドクター

A 回答 (7件)

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


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

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

グラフをコピーしてPowerPointに貼り付け
参考まで
「オートシェイプでうずまきを描くには?」の回答画像7
    • good
    • 1
この回答へのお礼

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

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

[回答番号: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 '曲線の頂点の数
の部分の数値を大きくすると渦の数が増え、ここで指定した頂点の数の約12分の1が渦の数になります(詳しいことを書くと混乱されるかも知れませんので省略いたします)。
    • good
    • 1
この回答へのお礼

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

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

[回答番号: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 '中心のX座標
 YY = ActiveWindow.Height / 2 '中心のY座標
 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)] で、線の太さや色を指定なさってください。
    • good
    • 0

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



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

歪になった曲線は「頂点の編集」で、修正します。
添付図は頂点の編集を行っている途中です。
「オートシェイプでうずまきを描くには?」の回答画像4
    • good
    • 0
この回答へのお礼

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

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

1)新しいスライドを挿入します。


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

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
    • good
    • 2

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


(パワポは持ってないので)

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
    • good
    • 0
この回答へのお礼

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

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

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


同類のQ&Aがでてきます。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング