Excel VBA質問箱 IV

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

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


58199 / 76732 ←次へ | 前へ→

【23265】Re:円弧を描く
発言  ichinose  - 05/3/17(木) 20:30 -

引用なし
パスワード
   ▼きりんさん さん:
こんばんは。
以前、円を描いたコードをちょっと変更しました。
Functionにした方が便利そうだったので再送です。


>はじめまして、
>ワ−クシ−トに絶対座標を使って、正確に円弧を描くVBAマクロを教えて下さい。
> 与条件
>  1.円弧の中心座標 Xo、Yo
>  2.円弧の半径   Ro
>  3.円弧の開始角度 Ii
>  3.円弧の終点角度 Io
>     角度は、左廻りです。
>宜しくお願いします。
> 
'==============================================================
Sub main()
  Dim shp As Shape
  Set shp = Mk_enko(ActiveSheet, 300, 100, 60, 45, 270)
End Sub
'=========================================================================
Function Mk_enko(sht As Worksheet, x As Double, y As Double, rs As Double, std As Double, edd As Double) As Shape
'円弧を作成する
'sht-----作成するシート
'x,y-----中心座標
'rs------半径
'std----開始角度
'edd----終了角度
'出力---Mk_enko--Shapeオブジェクト
  pai = WorksheetFunction.Pi
  strd = (1.5 - std / 180) * pai
  edrs = (1.5 - edd / 180) * pai
  With sht.Shapes.BuildFreeform(msoEditingAuto, x + rs * Cos(strd), y + rs * Sin(strd))
   For idx = strd - 0.15 To edrs Step -0.001
     .AddNodes msoSegmentLine, msoEditingAuto, x + rs * Cos(idx), y + rs * Sin(idx)
     Next idx
   Set Mk_enko = .ConvertToShape
   Mk_enko.Fill.Visible = msoFalse
   End With
End Function

4 hits

【23257】円弧を描く きりんさん 05/3/17(木) 15:03 質問
【23265】Re:円弧を描く ichinose 05/3/17(木) 20:30 発言

58199 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free