VBAにて図形を描く

Question

excel VBAにて図形を描写したいと考えております。
葉のような形（葉脈も含む）を乱数的に散りばめて描写してのです。
現在、下のようなコードで葉の形は作れることが分かったのですが（数値はまだ未定）、葉脈のような線を同時に描くこと、また乱数的に散りばめることが可能でしょうか？
詳しい方がいましたら教えていただきたいです。

Sub フリーフォームでなめらか図形1()
    
    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 50, 55)
        .AddNodes msoSegmentCurve, msoEditingAuto, 40, 30
        .AddNodes msoSegmentCurve, msoEditingAuto, 80, 30
        .AddNodes msoSegmentCurve, msoEditingAuto, 80, 50
        .AddNodes msoSegmentCurve, msoEditingAuto, 50, 55
        .ConvertToShape.Select
    End With
    
    
End Sub

Answer 1

mako1972さんにリクエストされたので作ってみました。
ただmako1972さんも言っていますが、葉っぱの書き方は人それぞれで、図形を組み合わせていかにそれっぽく見せるかだと思います。
マクロの記録を使ってフリーフォームで書けばまあそれなりの見た目のはできると思いますが、ここに載せるにはやたら細かい座標で膨大なデータになってしまうので諦めました。
なので今回は楕円と線だけで書いています。
あとは1枚描いた葉っぱをグループ化して、複製して使いまわしています。
求めているものとは異なると思いますので、参考程度でお願いします。

Sub sample()
    
    Dim i As Long
'    Dim r As Long
    
    Shapes.SelectAll
    Selection.Delete
    
    Call leaf
    
    Shapes("leaf").Cut
    
    For i = 1 To 10
        Paste
        With Selection.ShapeRange
            .Left = Int(Rnd * 500)
            .Top = Int(Rnd * 500)
            .Width = 30 + Int(Rnd * 20)
            .Height = 40 + Int(Rnd * 50)
            .Rotation = Int(Rnd * 360)
'           r = Int(Rnd * 3)                 ' 左右または上下反転させる処理 今回は左右対称の絵なので使ってません
'           If r <> 2 Then tmp.Flip r
        End With
    Next
    
End Sub

Sub leaf()

    Shapes.AddShape msoShapeOval, 180, 60, 40, 60
    Shapes.AddConnector msoConnectorStraight, 200, 60, 200, 130
    Shapes.AddConnector msoConnectorStraight, 200, 80, 190, 70
    Shapes.AddConnector msoConnectorStraight, 200, 80, 210, 70
    Shapes.AddConnector msoConnectorStraight, 200, 95, 185, 85
    Shapes.AddConnector msoConnectorStraight, 200, 95, 215, 85
    Shapes.AddConnector msoConnectorStraight, 200, 110, 185, 100
    Shapes.AddConnector msoConnectorStraight, 200, 110, 215, 100
    
    Shapes.SelectAll
    
    With Selection.ShapeRange.Line
        .ForeColor.RGB = RGB(0, 0, 0)
    End With
    With Selection.ShapeRange.Fill
        .ForeColor.RGB = RGB(146, 208, 80)
    End With
    
    Selection.ShapeRange.Group.Name = "leaf"

End Sub

Comments

[mako1972]

ttyp03様お忙しいところありがとうございました。勉強になります。

早速、コード一式、標準モジュールにコピーしてsampleマクロを実行させていただいたところ、Pasteの部分で
sub またはfunctionが定義されていませんというエラーで進まなくなってしまいました・・。

何か設定など準備が必要なものでしょうか・。。

[ttyp03]

例によって、実行するシートに貼り付けてください。
標準モジュールではなく。

[mako1972]

おおおおおおおおおおおおお。すっげーーーー。

これはVIP(MVPでした)回答ですね！！

[ttyp03]

もうちょっと絵心があればよかったんですけどね。
これでも結構大変でした。

[mako1972]

無茶ぶりして申し訳ありませんでした。
すごいもの見せてもらいましたー！

質問者さんも満足されると思います。ありがとうございました。

Answer 2

前のレスでも回答させていただいた通り、Excel VBAでの図形描画は推奨していませんが。。
素人ながら
ご提示されている葉っぱの法則性を関数化してみました。
適当かもしれませんが、このように関数化して、描画位置を乱数を発生させればいけるかもしれませんね。一応、3つの葉っぱが、指定座標に表示されます。

Sub 図形作成()
'呼び出し側
Call zukei(50, 55)'ここのX,Yを乱数化
Call zukei(40, 80)'ここのX,Yを乱数化
Call zukei(80, 100)'ここのX,Yを乱数化
End Sub

Sub zukei(a As Integer, b As Integer)
'描画関数
Dim size_a As Integer
Dim size_b As Integer

siza_a = a
size_b = b


    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, siza_a, size_b)
        .AddNodes msoSegmentCurve, msoEditingAuto, siza_a - 10, size_b - 25
        .AddNodes msoSegmentCurve, msoEditingAuto, siza_a + 30, size_b - 25
        .AddNodes msoSegmentCurve, msoEditingAuto, siza_a + 30, size_b - 5
        .AddNodes msoSegmentCurve, msoEditingAuto, siza_a, size_b
        .ConvertToShape.Select
    End With



End Sub

Comments

[meimm]

コメントありがとうございます。ここのx,yを乱数化と書いている場所で乱数的に描写できるのでしょうか？コンパイルしてみましたが、シート指定も可能ですか？

[mako1972]

乱数は置いておきます。描画シート名を指定する場合は
下記のように修正してください。

Sub 図形作成()

Call zukei("data", 50, 55)
Call zukei("data", 40, 80)
Call zukei("data", 80, 100)
End Sub

Sub zukei(mysheet As String, a As Integer, b As Integer)
Dim size_a As Integer
Dim size_b As Integer

siza_a = a
size_b = b

With Sheets(mysheet).Shapes.BuildFreeform(msoEditingAuto, siza_a, size_b)
.AddNodes msoSegmentCurve, msoEditingAuto, siza_a - 10, size_b - 25
.AddNodes msoSegmentCurve, msoEditingAuto, siza_a + 30, size_b - 25
.AddNodes msoSegmentCurve, msoEditingAuto, siza_a + 30, size_b - 5
.AddNodes msoSegmentCurve, msoEditingAuto, siza_a, size_b
.ConvertToShape.Select
End With

End Sub

[mako1972]

少し調べてみました。乱数発生＋シート名の指定を含めると
こうでしょうか・・

Sub 図形作成()
Dim a As Integer
Dim b As Integer
Dim iMin As Integer '// 最小値
Dim iMax As Integer '// 最大値
Dim i as Integer

iMin = 50
iMax = 300

'// 疑似乱数列を初期化
Call Randomize

For I = 1 To 100

a = Int((iMax - iMin + 1) * Rnd + iMin)
b = Int((iMax - iMin + 1) * Rnd + iMin)
Call zukei("data", a, b)

Next
End Sub

Sub zukei(mysheet As String, a As Integer, b As Integer)
Dim size_a As Integer
Dim size_b As Integer

siza_a = a
size_b = b

With Sheets(mysheet).Shapes.BuildFreeform(msoEditingAuto, siza_a, size_b)
.AddNodes msoSegmentCurve, msoEditingAuto, siza_a - 10, size_b - 25
.AddNodes msoSegmentCurve, msoEditingAuto, siza_a + 30, size_b - 25
.AddNodes msoSegmentCurve, msoEditingAuto, siza_a + 30, size_b - 5
.AddNodes msoSegmentCurve, msoEditingAuto, siza_a, size_b
.ConvertToShape.Select
End With

End Sub

[meimm]

シート指定もしてコンパイルしたのですが、楕円形のようなものが三つ描かれます。葉のような形に葉脈の線を入れることは難しいのでしょうか？

[mako1972]

乱数を発生させて、100個楕円形のものが描画されるサンプルを提示させていただきました。
>>葉脈のような線を同時に描くこと

葉のようなものを描画するのはいったん、別に考えていただけるといいかと思います。

ただし、線はVBAの命令で追加できると思いますよ。。。

>>また乱数的に散りばめることが可能でしょうか？
私が提示させていただいたサンプルは、描画のサンプルができれば
関数化＋乱数で指定の個数・自由に描画できるという内容です。
したがって、葉っぱ内の詳細な描画の作成方法について（線の追加）は、他の方の回答を期待してください。

[mako1972]

エクセルの機能で葉っぱを作成されいる方がいるようですね。
https://ameblo.jp/m-craft/image-11186489260-11839089451.html

他作業をマクロ記録して（膨大なコードになりそうですが）、検証してみるのも
ありかもしれませんね。

[meimm]

記事見させて頂きました。確かに膨大なコードになりそうです。VBAで葉のような図形を描くことは難しいのかもしれませんね。書き方がわかる方が現れるまで待ってみようと思います。ご協力ありがとうございました。また、詳しい方など周りにいましたら、聞いてみていただけるとありがたいです。

[mako1972]

オートシェイプを変形したり。今回の場合は、ハートをふたつ組み合わせて葉っぱを作る例など
試してみました。結構、アート的に作れそうですが、最終的にはグループ化して
一つの図形にして絵を描画していくのが妥当なような気がします。

手書きしたものをコピーしたり、角度や向きを変えて指定個数作ることは可能だと思います。
この辺は、VBAで描画したいということとは異なる手法になると思います。

VBAで実行したいとなると、需要が少ない分野となりますので他の方の回答をまっていただけると
よいかと思います。
過去のVBAの雑誌で、VBAからイラストレーターを使うなどのサンプルはみたことがありますが
。。。

[mako1972]

こちらの案件で回答依頼しましたが
回答依頼をお願いしていいものか
混乱してしまい。依頼者様にも
ご迷惑をお掛けしてしまいました。

https://teratail.com/questions/281583

[ttyp03]

＞mako1972さん
＞こちらの案件で回答依頼しましたが、うまく意図が伝わらず・・。申し訳ありません。
私のことでしょうか？
本日なかなか忙しくコーディングまで手が回っておりません。
もう少しお待ちください。
そもそも葉っぱをどう書くかというところから考えないといけないので。
たぶん1枚葉っぱが書けたら、グループ化して、コピーしてランダムで位置とサイズと左右反転とかやればいいんじゃないかと思いますけど。

[mako1972]

すみません。通知が過去分と混じって
わからなくなってしまいました。
葉っぱをvbaで書きたいという
内容で私のは無理かもという。。

凄い人といわれて
そういえば。。という軽い気持ちで
ご相談してしまい申し訳ありません。
お時間ある時にレスお願いいたします。

[meimm]

ご協力感謝します。

[mako1972]

ちなみ勝手な無茶振りに
回答頂いています。

ヒントいただけるといいですね。