資料作成用VBA：マップ上に移動範囲を描画する

こんにちは！するどいプランナーです！
今日は簡単なVBAの使用例の後編として「マップ上にアイコンからの範囲を描画する」を説明します。

前編は↓↓

blog.ahiru.co.jp

前後編どちらも「if文とfor文が読める人なら改修して使える」くらいの難易度かなと思います。エクセルファイル上でVBAが使用できる状態にする方法は記事内で説明しません。

完成イメージ

• マップ画像上に宝箱から10秒、20秒、30秒で移動できる範囲を表示する
• 描画した移動範囲を消す

というものを作っていきます。

方法としては、地図画像上にエクセル機能で図形を描画し、図形に設定したテキストで図形を判別して各種制御を行います。

手順①地図上にアイコンを配置する

前編で配置したアイコンですね。後編でも同じものを使用します。

手順②VBAマクロを書く

今回は３つの関数を作成します。

(1)円を１個だけ描く

(2)(1)を使用して宝箱の周囲に移動範囲を描く

(3)描いた移動範囲を消す

'定数の定義：１秒で進む距離[pt]
Const R_WALK As Integer = 10

R_WALKは定数で、移動範囲の半径に使用します。実際にプレイして値を調整しましょう。

' (1)円を１個描く
'   [引数] cLeft 中央位置Left
'   [引数] cTop  中央位置Top
'   [引数] r     円半径
Sub 円を描く(cLeft As Integer, cTop As Integer, r As Integer)
    Set newShape = ActiveSheet.Shapes.AddShape(msoShapeOval, cLeft - r, cTop - r, r*2, r*2)

    '図形の識別にはTextFrame.Characters.Textを使用する
    newShape.TextFrame.Characters.Text = "#移動範囲#歩き" 
    newShape.TextFrame.Characters.Font.color = COLOR_WALK
    newShape.Fill.ForeColor.RGB = 13998939 ' RGB(91, 155, 213)
    newShape.Fill.Transparency = 0.85 ' 透明度85%
End Sub

３つの引数を使用する関数です。中央位置の座標と半径です。

AddShape()では、描画する円の左上の座標を指定するため、-rしています。

newShape.Fill.ForeColor.RGB = 13998939 ' RGB(91, 155, 213)
の値13998939はRGBの値を整数に変換したもので、
整数の色コード = R + G*256 + B * 256 * 256
の計算式で算出することができます。

' (2)宝箱に移動範囲を描く
Sub 宝箱に移動範囲を描く()
    '全ての図形をループ
    For Each a In ActiveSheet.Shapes
        '図形がオートシェイプの場合
        If a.Type = 1 Then
            'テキストに「#宝箱」が含まれているかを判定
            If InStr(a.TextFrame.Characters.Text, "#宝箱") > 0 Then
                '中央の座標を取得
                Dim cTop As Integer, cLeft As Integer
                cTop = CInt(a.Top + a.Height / 2)
                cLeft = CInt(a.Left + a.Width / 2)
                
                '図形を追加
                円を描く cLeft, cTop, R_WALK * 30 ' 30秒で歩く距離
                円を描く cLeft, cTop, R_WALK * 20 ' 20秒で歩く距離
                円を描く cLeft, cTop, R_WALK * 10 ' 10秒で歩く距離
            End If
        End If
    Next
End Sub

図形に設定しているテキストから宝箱のシェイプを探し、(1)の関数を使用して移動範囲の円を描画しています。

円は10秒、20秒、30秒で到達できる位置がわかるように同心円を重ねて描画しています。後から描画した方が手前にくるため、30秒⇒20秒⇒10秒の順で描画しています。

' (3)移動範囲の円を消す
Sub 移動範囲を消す()
    '全ての図形をループ
    For Each a In ActiveSheet.Shapes
        '図形がオートシェイプの場合
        If a.Type = 1 Then
            'テキストに「#移動範囲」が含まれていれば、消す
            If InStr(a.TextFrame.Characters.Text, "#移動範囲") > 0 Then
                a.Delete
            End If
        End If
    Next
End Sub

描画した円を消す関数です。

手順③コントロールパネルを作る

前回同様ボタンでマクロを呼び出せるようにしましょう。

描画ボタンには(2)の関数を、削除ボタンには(3)の関数を設定します。

手順④挙動を確認する

実際にボタンを押して描画してみましょう！

移動範囲が青い円で描画されていますが、コントロールパネルのシェイプにも描画されちゃっていますね。

ここには描画したくないので、

• コントロールパネルのシェイプ名に「#コンパネ」を追加して識別できるようにしましょう。「#宝箱#コンパネ」になります。
• (2)宝箱に移動範囲を描く関数に「コンパネだったら描画しない」処理を追加しましょう

' (2)宝箱に移動範囲を描く
Sub 宝箱に移動範囲を描く()
    '全ての図形をループ
    For Each a In ActiveSheet.Shapes
        '図形がオートシェイプの場合
        If a.Type = 1 Then
            '#コンパネが含まれていない場合のみ描画する
            If InStr(a.TextFrame.Characters.Text, "#コンパネ") = 0 Then
                'テキストに「#宝箱」が含まれているかを判定
                If InStr(a.TextFrame.Characters.Text, "#宝箱") > 0 Then
                    '中央の座標を取得
                    Dim cTop As Integer, cLeft As Integer
                    cTop = CInt(a.Top + a.Height / 2)
                    cLeft = CInt(a.Left + a.Width / 2)
                    
                    '図形を追加
                    円を描く cLeft, cTop, R_WALK * 30 ' 30秒で歩く距離
                    円を描く cLeft, cTop, R_WALK * 20 ' 20秒で歩く距離
                    円を描く cLeft, cTop, R_WALK * 10 ' 10秒で歩く距離
                End If
            End If
        End If
    Next
End Sub

赤文字が追加した処理です。これを実行すると・・・

無事コンパネに描画されなくなりましたね。（ついでに透明度を調整しました）

◆まとめ

２回にわたって、資料作成に使用できそうなVBAを紹介しました。

移動範囲は例では「宝箱」からの距離で描画しました。
実際は「ワープ先」からの距離で描画すれば、
「このあたりに敵やイベントを配置したらプレイヤーが飽きずに進めそうだなー」などを考えるのに使ったりできるかなと思います。

１回資料を作るだけであればVBAを使う必要は低いかもしれませんが、
移動速度が変わったときや、移動秒数を変えたいときなど
繰り返す操作になる場合は時間が節約できます。

効率化の手段としてVBAの手札を持っておけるのは１つの強さなので、食わず嫌いにならずに挑戦してみてほしいです！