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 質問
【52288】Re:図を作って色分け…お急ぎ頂けると光栄... ぱっせんじゃー 07/11/5(月) 18:03 発言
【52289】Re:図を作って色分け…お急ぎ頂けると光栄... yasu 07/11/5(月) 18:23 質問
【52293】Re:図を作って色分け…お急ぎ頂けると光栄... ichinose 07/11/5(月) 21:39 発言
【52295】Re:図を作って色分け…お急ぎ頂けると光栄... [名前なし] 07/11/6(火) 0:02 質問
【52296】Re:図を作って色分け…お急ぎ頂けると光栄... ichinose 07/11/6(火) 7:46 発言
【52298】Re:図を作って色分け…お急ぎ頂けると光栄... yasu 07/11/6(火) 13:40 質問
【52312】Re:図を作って色分け…お急ぎ頂けると光栄... yata 07/11/7(水) 21:46 発言
【52316】Re:図を作って色分け…お急ぎ頂けると光栄... yasu 07/11/8(木) 15:23 質問
【52322】Re:図を作って色分け…お急ぎ頂けると光栄... yata 07/11/8(木) 21:24 発言

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