Excel VBA質問箱 IV

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

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


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

29720 / 76738

←次へ　｜　前へ→


	【52293】Re:図を作って色分け…お急ぎ頂けると光栄です

ichinose - 07/11/5(月) 21:39 -


	引用なし

	パスワード

▼yasu さん：
こんばんは。

>Basicを触ったことがありません。。。

「他の言語なら、知っている」という事ですか？

サンプルです。

新規ブックの標準モジュールに
'==================================================================
Sub main()
　 Dim idx As Double
　 Dim shp As Shape
　 Dim col As Long
　 col = 1
　 For idx = -30 To 270 Step 60
　　　Set shp = Mk_enko(ActiveSheet, 300, 300, 120, idx, idx + 60, col)
　　　col = col + 1
　　　Next
　 For idx = -30 To 270 Step 60
　　　Set shp = Mk_enko(ActiveSheet, 300, 300, 90, idx, idx + 60, col)
　　　col = col + 1
　　　Next
　 For idx = -45 To 225 Step 90
　　　Set shp = Mk_enko(ActiveSheet, 300, 300, 60, idx, idx + 90, col)
　　　col = col + 1
　　　Next
　 Set shp = Mk_enko(ActiveSheet, 300, 300, 30, 0, 360, col, False)
　　
　　　
End Sub
'=========================================================================
Function Mk_enko(ByVal sht As Worksheet, ByVal x As Double, ByVal y As Double, _
　　　　　　　　 ByVal rs As Double, ByVal std As Double, ByVal edd As Double, _
　　　　　　　　 ByVal col As Long, Optional ByVal gen As Boolean = True) As Shape
'円弧を作成する
'sht-----作成するシート
'x,y-----中心座標
'rs------半径
'std----開始角度
'edd----終了角度
'col----塗りつぶす色
'gen----True　弦を描く　False　弦なし
'出力---Mk_enko--Shapeオブジェクト
　 Dim sttX As Double
　 Dim sttY As Double
　 Dim pai As Double
　 Dim strd As Double
　 Dim edrs As Double
　 Dim idx As Double
　 pai = WorksheetFunction.Pi
　 strd = (1.5 - std / 180) * pai
　 edrs = (1.5 - edd / 180) * pai
　 If gen = True Then
　　　sttX = x
　　　sttY = y
　 Else
　　　sttX = x + rs * Cos(strd)
　　　sttY = y + rs * Sin(strd)
　　　strd = strd - 0.15
　　　End If
　 With sht.Shapes.BuildFreeform(msoEditingAuto, sttX, sttY)
　　　For idx = strd To edrs Step -0.001
　　　　 .AddNodes msoSegmentLine, msoEditingAuto, x + rs * Cos(idx), y + rs * Sin(idx)
　　　　 Next idx
　　　If gen = True Then .AddNodes msoSegmentLine, msoEditingAuto, x, y
　　　Set Mk_enko = .ConvertToShape
　　　With Mk_enko.Fill
　　　　 .Visible = msoTrue
　　　　 .ForeColor.SchemeColor = col
　　　　 End With
　　　End With
End Function

mainを実行してください。

>
>そんな私ですが、以下のような物を作れと言われました。
>わかりません。できません。助けてください。。
>
> 　　　　＿＿＿＿＿＿＿
> 　　　／　　　　　　　＼
> 　　／＼　＿＿＿＿＿　／＼
> 　／　　／　　　　　＼　　＼
> ／　　／＼　＿＿＿　／＼　　＼
>|　　／　　／　　　＼　　＼　｜
>|　｜　／＼　＿　／＼　｜　｜
>|＿_｜＿|　　／　＼　　|＿｜＿｜
>|　｜　|　　＼＿／　　|　｜　｜
>|　｜　＼／　　　＼／　｜　｜
>|　　＼　　＼＿＿＿／　　／　｜
> ＼　　＼／　　　　　＼／　　／
>　＼　　＼＿＿＿＿＿／　　／
>　　＼／　　　　　　　＼／
>　　　＼＿＿＿＿＿＿＿／
>
↑これと似たようなものが作成されるはずです。

後は、研究してみてください。

0 hits

▼

【52287】図を作って色分け…お急ぎ頂けると光栄です yasu 07/11/5(月) 17:54