Excel VBA質問箱 IV

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

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


29907 / 76738 ←次へ | 前へ→

【52104】Re:Addlineで作った図形の塗りつぶしについて
発言  ichinose  - 07/10/21(日) 11:15 -

引用なし
パスワード
   おはようございます。

>これで下記のプログラムは終了するのですが、50個描画したうちのいくつかの三角形を青で塗りつぶしたいと考えています。たとえば表1の番号2,3,4の三個の三角形を塗りつぶすなどです。Shapes.Addlineを使った描画ではやはり塗りつぶすことはできないのでしょうか??50個描画したうちのいくつかの三角形を塗りつぶす方法を探しています。よろしくお願いします。
詳細な記述で非常にわかりやすい説明ですね。
(掲載プロシジャーの記述場所「シートモジュール」と余白という変数の値とセルm3の値も例題から、既定してくだされば、個人的には言うことなしです)

Lineのみだと難しいすから、別図形で三角形を作成し、塗りつぶし設定を行うのは
いかがですか?

検討してください。


>Private Sub CommandButton1_Click()
>
> Dim i As Integer
>  Dim 枠左 As Single, 枠上 As Single
>  Dim 枠幅 As Single, 枠高 As Single
>  Dim 節点の数, 要素の数, 変位倍率, 座標X(), 座標Y()
>  Dim 節点1, 節点2, 節点3
>  Dim MinX As Single, MinY As Single
>  Dim MaxX As Single, MaxY As Single
>  Dim Base左 As Single, Base下 As Single, Ratio As Double
>
>  枠左 = Range("f10:l32").Left + 余白
>  枠上 = Range("f10:l32").Top + 余白
>  枠幅 = Range("f10:l32").Width - 余白 * 2
>  枠高 = Range("f10:l32").Height - 余白 * 2
>
>  
>    節点の数 = Range("m3")
>    Dim 座標Xi, 座標Yi
>    For i = 1 To 節点の数
>      座標Xi = Range("n5").Offset(i, 0)
>      座標Yi = Range("o5").Offset(i, 0)
>    Next i
>    座標X1 = Range("n6")
>    
>    座標Y1 = Range("o6").Value
>    
>    
>    MinX = 座標X1
>    MinY = 座標Y1
>    MaxX = 座標X1
>    MaxY = 座標Y1
>    For i = 2 To 節点の数
>      If MinX > 座標Xi Then MinX = 座標Xi
>      If MinY > 座標Yi Then MinY = 座標Yi
>      If MaxX < 座標Xi Then MaxX = 座標Xi
>      If MaxY < 座標Yi Then MaxY = 座標Yi
>    Next i
>    If MaxX - MinX > MaxY - MinY Then
>      Ratio = 枠幅 / (MaxX - MinX)
>      Base左 = 枠左 - MinX * Ratio
>      Base下 = 枠上 + 枠高 - MinY * Ratio _
>            - (枠高 - (MaxY - MinY) * Ratio) / 2
>    Else
>      Ratio = 枠高 / (MaxY - MinY)
>      Base左 = 枠左 - MinX * Ratio _
>            + (枠幅 - (MaxX - MinX) * Ratio) / 2
>      Base下 = 枠上 + MaxY * Ratio
>    End If
>    
>        Dim 表1 As Range
>  Dim 表2 As Range
>  Dim v As Variant
>
>  
>  Set 表1 = Range("Q5:T35")
>  Set 表2 = Range("M5:O41")
>  With 表1
>    For i = 2 To .Rows.Count ' 実データである2行目から
>     
>        v = Application.Match(.Cells(i, 2), 表2.Columns(1), 0)
>        vv = Application.Match(.Cells(i, 3), 表2.Columns(1), 0)
>        vvv = Application.Match(.Cells(i, 4), 表2.Columns(1), 0)
>                    座標X節点1 = 表2.Cells(v, 2)
>          座標Y節点1 = 表2.Cells(v, 3)
>          座標X節点2 = 表2.Cells(vv, 2)
>          座標Y節点2 = 表2.Cells(vv, 3)
>          座標X節点3 = 表2.Cells(vvv, 2)
>          座標Y節点3 = 表2.Cells(vvv, 3)
        If i Mod 2 = 0 Then
          Call mk_triangle(Base左 + 座標X節点1 * Ratio _
                 , Base下 - 座標Y節点1 * Ratio _
                 , Base左 + 座標X節点2 * Ratio _
                 , Base下 - 座標Y節点2 * Ratio _
                 , Base左 + 座標X節点3 * Ratio _
                 , Base下 - 座標Y節点3 * Ratio)
          End If
>        Shapes.AddLine Base左 + 座標X節点1 * Ratio _
>              , Base下 - 座標Y節点1 * Ratio _
>              , Base左 + 座標X節点2 * Ratio _
>              , Base下 - 座標Y節点2 * Ratio
>        Shapes.AddLine Base左 + 座標X節点2 * Ratio _
>              , Base下 - 座標Y節点2 * Ratio _
>              , Base左 + 座標X節点3 * Ratio _
>              , Base下 - 座標Y節点3 * Ratio
>        Shapes.AddLine Base左 + 座標X節点3 * Ratio _
>              , Base下 - 座標Y節点3 * Ratio _
>              , Base左 + 座標X節点1 * Ratio _
>              , Base下 - 座標Y節点1 * Ratio
>      
>    Next i
>End With
>  END SUB
'====================================================================
Function mk_triangle(ByVal x1 As Double, ByVal y1 As Double, _
           ByVal x2 As Double, ByVal y2 As Double, _
           ByVal x3 As Double, ByVal y3 As Double) As Shape
  With Shapes.BuildFreeform(msoEditingAuto, x1, y1)
    .AddNodes msoSegmentLine, msoEditingAuto, x2, y2
    .AddNodes msoSegmentLine, msoEditingAuto, x3, y3
    .AddNodes msoSegmentLine, msoEditingAuto, x1, y1
    Set mk_triangle = .ConvertToShape
    With mk_triangle
      .Fill.Visible = msoTrue
      .Fill.Solid
      .Fill.ForeColor.SchemeColor = 2
      End With
  End With
End Function


上記の例だと、CommandButton1_Click内の 三角形作成ループ内での
iが偶数の場合、赤で塗りつぶしています。

試してみてください。

0 hits

【52102】Addlineで作った図形の塗りつぶしについて ちゃや 07/10/21(日) 9:35 質問
【52104】Re:Addlineで作った図形の塗りつぶしについ... ichinose 07/10/21(日) 11:15 発言
【52105】Re:Addlineで作った図形の塗りつぶしについ... ichinose 07/10/21(日) 11:25 発言
【52106】Re:Addlineで作った図形の塗りつぶしについ... ちゃや 07/10/21(日) 13:22 質問
【52111】Re:Addlineで作った図形の塗りつぶしについ... りん 07/10/21(日) 15:16 発言
【52115】Re:Addlineで作った図形の塗りつぶしについ... ちゃや 07/10/21(日) 20:21 質問
【52114】Re:Addlineで作った図形の塗りつぶしについ... ichinose 07/10/21(日) 19:50 発言
【52159】Re:Addlineで作った図形の塗りつぶしについ... ちゃや 07/10/25(木) 18:31 質問
【52160】Re:Addlineで作った図形の塗りつぶしについ... ichinose 07/10/25(木) 21:19 発言

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