excel VBA 連続した図形を描きたい

Excel マクロについての質問です。
マクロを用いて下図のような柄を作りたいと考えています。

Sub 
    

      For i = 1 To 3    '---3回処理を繰り返す
    
          With ActiveSheet.Shapes.AddLine _
              (BeginX:=Range("C4").Left, BeginY:=Range("C4").Top, _
               EndX:=Range("C8").Left, EndY:=Range("C8").Top)
               ActiveSheet.Shapes.AddShape(msoShapeRightTriangle, 15, 15, 15, 15).Select
              
           .Rotation = i * 60!
           '---ループ回数に応じて、角度を60度づつ変化させる
          End With
      Next i
  
      
End Sub

60°づつ回転させて、線を描くことはできましたが、線の先端に三角形を付けるのが難しく悩んでいます。
分かる方に教えていただきたく質問させていただきました。まず、このような柄は作成可能なのでしょうか。

行動規範の内容に同意します

回答2件

ベストアンサー

回答ではないです。
似たような絵が描けないかなとがんばってみた結果です。
見た目で座標調整しているだけなので、拡大すると線がずれまくりです。
▲部分は未実装。
というか柄の法則的に、3本の線が交わった中を塗る感じですかね。
数学的計算ができる人じゃないと難しいです（私は無理）
あと今は線を回転させてますが、回転ではなく、きちんと計算して開始終了座標を求める必要があると思います。

VBA
1Sub test()
2    Dim x As Long
3    Dim y As Long
4    Dim l As Long
5    
6    l = 60
7    
8    x = 100
9    y = 100
10    Call threeline(x, y, l)
11    Call threeline(x, y, l)
12    Call threeline(x, y, l)
13    
14    x = 80
15    y = 140
16    Call threeline(x, y, l)
17    Call threeline(x, y, l)
18    Call threeline(x, y, l)
19    
20    x = 60
21    y = 180
22    Call threeline(x, y, l)
23    Call threeline(x, y, l)
24    Call threeline(x, y, l)
25    
26End Sub
27
28Sub threeline(x As Long, y As Long, ByVal l As Long)
29
30    Dim sp As Shape
31    For i = 1 To 3    '---3回処理を繰り返す
32        Set sp = Shapes.AddLine(beginx:=x, BeginY:=y, EndX:=x, EndY:=y + l)
33        sp.Rotation = i * 60
34    Next i
35    x = x + 45
36    y = y - 5
37
38End Sub

実行結果を載せておきます。
シートの枠線は非表示にしています。

ご要望のあった▲に対応したものを作ってみました。
▲の書き方が適当（というか作りっぱなし）なのでたぶん正三角形にはなってないです。
なので相変わらずずれてますが、ご勘弁ください。

VBA
1Sub test()
2    Dim x As Long
3    Dim y As Long
4    Dim l As Long
5
6    l = 60
7
8    x = 100
9    y = 100
10    Call threeline(x, y, l)
11    Call threeline(x, y, l)
12    Call threeline(x, y, l)
13
14    x = 81
15    y = 141
16    Call threeline(x, y, l)
17    Call threeline(x, y, l)
18    Call threeline(x, y, l)
19
20    x = 62
21    y = 182
22    Call threeline(x, y, l)
23    Call threeline(x, y, l)
24    Call threeline(x, y, l)
25
26End Sub
27
28Sub threeline(x As Long, y As Long, ByVal l As Long)
29
30    Dim sp As Shape
31    For i = 1 To 3    '---3回処理を繰り返す
32        Set sp = Shapes.AddLine(beginx:=x, BeginY:=y, EndX:=x, EndY:=y + l)
33        sp.Rotation = i * 60
34    Next i
35    
36    With Shapes.AddShape(msoShapeIsoscelesTriangle, x + l / 2 - 11, y + l / 2 / 2 - 4, 7, 7)
37        .Rotation = 90
38    End With
39    With Shapes.AddShape(msoShapeIsoscelesTriangle, x - 7, y, 7, 7)
40        .Rotation = 270
41    End With
42    
43    x = x + 45
44    y = y - 5
45
46End Sub

投稿2020/07/31 06:03

編集2020/08/04 06:39

ttyp03

総合スコア17000

mako1972

2020/07/31 06:20 編集

素晴らしいですね。実行してみたくて実行させていただいたました。なぜか、 Set sp = Shapes.AddLine(beginx:=x, BeginY:=y, EndX:=x, EndY:=y + l) でオブジェクトが必要です、というエラーになるようです・・。 Set sp = Sheets("sheet1").Shapes.AddLine(beginx:=x, BeginY:=y, EndX:=x, EndY:=y + l) としたらうまくいきました。

ttyp03

2020/07/31 06:41

あ、ごめんなさい。描画するシートに記述する前提で書いてました。標準モジュールに記述する場合はシートの指定が必要です。

mako1972

2020/07/31 06:42

勉強になりました。

mako1972

2020/08/03 03:49 編集

ttyp03様、下記のレスにご協力をお願いいただけると嬉しいです。 https://teratail.com/questions/281863

mmjon

2020/08/03 04:30

実行させていただきました。コードが分かりやすく理解しやすかったです。線の重なりは座標計算が必要になってくるのですね。

ttyp03

2020/08/03 04:35

＞mmjonさん線の重なりはxとyの増減計算を微調整してもらえれば解消できると思いますが、△部分を▲にするにはそれなりの数学的計算が必要と思います。また回答したコードはあくまでも見た目をそれっぽくしているだけです。どこまでを求めているのかにもよるのですが、きちんと座標を計算する必要があるのか、それともあくまでも見た目だけの話なのか。

ttyp03

2020/08/03 04:35

＞mako1972さん時間あるときに見てみます。

mako1972

2020/08/03 04:37

ありがとうございます。

mmjon

2020/08/03 04:44

アート的なものを追求しているため、見た目の話になると思います。線の重なりはわざとずらすことによって味がでているのかなとも思いました。なるほど。△を▲にするのはかなり至難の技のようですね。

ttyp03

2020/08/03 05:39

何かの課題かと思ってましたがそういうことでもないのですね。今思いついたのですが、▲は左向きか右向きのどちらかしかないので、座標決め打ちでいいならなんとかなるような気がしました。塗りつぶす、のではなく、▲（左向きか右向き）の図形を置く感じで。解決済みになってしまったので、これ以上はがんばりませんが。