| |
おはようございます。
>これで下記のプログラムは終了するのですが、50個描画したうちのいくつかの三角形を青で塗りつぶしたいと考えています。たとえば表1の番号2,3,4の三個の三角形を塗りつぶすなどです。Ｓhapes.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 ' 実データである２行目から
>
> 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が偶数の場合、赤で塗りつぶしています。
試してみてください。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 07/10/21(日) 15:16 -
