VBA 電波の図形を作成するマクロ

今回は電波の図形を作成するマクロを作った。
といってもサイン派みたいなのではなく、イラストでよくある電波でてますよーというアイコンみたいなもの。

下図のように基本図形の「円弧」を使って作画するのだが、手動でやるとどうにも綺麗にできないのでプログラムで作ることにした。

完成したシェイプはパワポにコピーして使う。

コード

以下コードのMainを実行すると、アクティブシートに電波が綺麗に描画される。
実行するとアクティブシートの既存シェイプが消えるので注意。このコードはまっさらなシートで実行する想定。

Sub Main()
    Call DeleteAllShape
    Call DrawRadioWave( _
        directivity:=40, _
        color:=RGB(255, 100, 100), _
        frequency:=10, _
        acceleration:=1.2, _
        intensity:=1)
    ActiveSheet.Shapes.SelectAll
    Selection.ShapeRange.Group
End Sub

Sub DrawRadioWave(directivity, color, frequency, acceleration, intensity)
    Dim sh As Shape, sh2 As Shape
    pos = 10 * acceleration ^ (freqency - 1)
    Set sh = ActiveSheet.Shapes.AddShape(msoShapeArc, pos, pos, 10, 10)
    sh.Adjustments.Item(1) = -90 - directivity / 2
    sh.Adjustments.Item(2) = -90 + directivity / 2
    For t = 1 To frequency - 1
        sh.Line.Weight = intensity
        sh.Line.ForeColor.RGB = color
        Set sh2 = sh.Duplicate
        sh2.Top = sh.Top
        sh2.Left = sh.Left
        sh2.ScaleWidth acceleration, msoFalse, msoScaleFromMiddle
        sh2.ScaleHeight acceleration, msoFalse, msoScaleFromMiddle
        Set sh = sh2
    Next
End Sub

Sub DeleteAllShape()
    For Each sh In ActiveSheet.Shapes
        sh.Delete
    Next
End Sub

パラメータの解説

DrawRadioWave関数に渡すパラメータ(引数)によって描画される電波が変化する。

    Call DrawRadioWave( _
        directivity:=40, _
        color:=RGB(255, 100, 100), _
        freqency:=10, _
        acceleration:=1.2, _
        intensity:=1)

directivity(指向性)

電波の描画角度を表す。角度は向きじゃなくて、幅の意味なので注意。

color(色)

色。そのまま。

frequency(周波数)

なんちゃって周波数。単に線の数。
これを増やす場合、accelerationを下げないとでかくなる。
でかくなると描画位置がだいぶ右にズレる。なぜなら円弧は表示範囲だけでなく円周分の幅を取るので。

acceleration(加速度)

電波が広がる度にサイズがどれくらい大きくなるかを元の倍率で表す。
1.2~1.5くらいが適正。これを上げる場合、frequencyを下げないとでかくなる。

intensity(強度)

電波強度。単に線の太さ。
1~3くらいが適正。

以上