VBA: 1_エクセルで部屋のレイアウト(模様替え)検討

VBAの記事を載せてみようと思います。
Python同様に温かい目で見守って頂けると助かります。独学、趣味の一環なので分からないところなどはAIに頼ったりもします。

※本ページの内容を利用したことによって生じたいかなる損害についても、当方は責任を負いかねます。掲載内容の正確性や動作を保証するものではありません。ご利用の際はご自身の判断と責任でお願いいたします。

今回エクセルで作ったツール

今回作ったツールは家の模様替えをする時に、どの家具をどこに置くかを机上で検討するためのツール。（オートシェイプで家具に見立てた四角の枠をいっぱい作るツール）

1.エクセルシート上に用意した薄黄色の表に入力。
部屋や家具の　”名称” , ”サイズ”　と　オートシェイプの　”色”　を定義する。

2. ”オートシェイプ作成” ボタンを押すと、定義した名称が入った四角のオートシェイプが作成される。オートシェイプのサイズは入力した数値と倍率に基づいて作られる。

3.オートシェイプを好きに動かして配置を検討する。

※あらかじめ、家具などの寸法の測定は必要。

きっかけ　

子供も成長し、部屋の家具の入れ替えや配置換えを検討しようと思ったときに、これは全部ここに収まりきるのだろうか？スペースってあるのか？などを家具を運ぶ前に確認したかった。

実際に家具を運んでみて、あーでもない、こーでもない、というのでもよかったのだが、
無駄にエクセルを使いたいというのもあって検討してみた。

　　

エクセルシート上での準備、入力

1.エクセルシート上での準備と入力：

◆赤枠エリア　：ここに部屋のサイズや家具のサイズを入力していく。
C列 (名称)：　家具の名称、オートシェイプにこの名称テキストが入る

D＆E列 (長さ、幅)：　家具のサイズ　横ｃｍ ＊ 縦ｃｍ　を入力

F列 (色)：オートシェイプの色を選択
Ｆ20~のセルではF12～F17を ”データの入力規則” の “リスト” に設定し、その中から選択できるようにしている。

オレンジで囲った箇所のセルはVlookUpを設定しており、選択した色のＲＧＢ値を定義テーブル（緑で囲ったエリア）から参照するようにした。　　　　
VBA上ではこのRGB値でオートシェイプの色を指定している。

G20セル　”=VLOOKUP($F20,$F$12:$I$17,2,FALSE)”　といった感じ。


◆水色枠エリア
D8セル：オートシェイプの大きさ倍率をここで指定。　”２”くらいがちょうどいいかもしれない。
使い勝手を多少良くしようと思い、オートシェイプのサイズを可変できるようにした。


◆緑枠エリア
オートシェイプの色名とRGB値を定義。
色と、色に合わせたRGB値をあらかじめ設定しておく（0~255）。
各色の設定は自分の独断で添付図の数値にした。好みで調整してもよい。

他にはマクロを実行するための　”オートシェイプ作成”　と　”Delete　削除”　のテキストBoxを用意。実行マクロを後からこのテキストBoxにセットした。

VBAコード

”オートシェイプ作成”のテキストBoxに紐づけたマクロが下記。エラー処理は抜けているところがあると思う。

Sub MakeAutoShapes()

    Dim i As Long
    Dim originx As Double, originy As Double
    Dim ratio As Double
    Dim s_width As Double, s_height As Double
    Dim eventname As String
    Dim shp As Shape
    Dim color_r As Integer, color_g As Integer, color_b As Integer
    
    '-----------------------------------------
    ' 図形を配置し始める基準位置（左上座標）
    '-----------------------------------------
    originx = Range("K10").Left
    originy = Range("K10").Top

    '-----------------------------------------
    ' 図形サイズの倍率（セル D8 の値）
    ' 図形の幅・高さに掛けて調整する
    '-----------------------------------------
    ratio = Cells(8, 4).Value

    '-----------------------------------------
    ' メインループ：20行目からひとまず300行目まで処理。十分だと思う。
    ' 各行のデータをもとに図形を作成する
    '-----------------------------------------
    For i = 20 To 300

        '-----------------------------------------
        ' イベント名（列C）が空ならスキップ
        '-----------------------------------------
        If Cells(i, 3).Value = "" Then
            GoTo CONTINUE
        End If
        
        '-----------------------------------------
        ' 色指定の取得（列G） 色を設定し忘れた際のエラー処理。
        ' エラー値の場合はグレー(230,230,230)にする
        '-----------------------------------------
        Debug.Print Cells(i, 7)
        If IsError(Cells(i, 7).Value) Then
            color_r = 230
            color_g = 230
            color_b = 230
        Else
            color_r = Cells(i, 7).Value
            color_g = Cells(i, 8).Value
            color_b = Cells(i, 9).Value
        End If
        
        '-----------------------------------------
        ' 図形に表示する文字列（イベント名）
        ' 図形の幅・高さ（倍率を掛けて調整）
        '-----------------------------------------
        eventname = Cells(i, 3).Value
        s_width = Cells(i, 4).Value2 * ratio
        s_height = Cells(i, 5).Value2 * ratio

        '-----------------------------------------
        ' 図形を作成し、変数 shp に格納
        ' msoShapeRectangle = 四角形
        '-----------------------------------------
        Set shp = ActiveSheet.Shapes.AddShape( _
                    msoShapeRectangle, _
                    originx, originy, s_width, s_height)

        '-----------------------------------------
        ' 図形の塗りつぶし色を設定
        '-----------------------------------------
        With shp.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(color_r, color_g, color_b)
            .Transparency = 0
            .Solid
        End With

        '-----------------------------------------
        ' 図形の枠線（黒）
        '-----------------------------------------
        shp.Line.ForeColor.RGB = RGB(0, 0, 0)

        '-----------------------------------------
        ' 図形内テキストの設定（TextFrame2 を使用）
        '-----------------------------------------
        With shp.TextFrame2
            .VerticalAnchor = msoAnchorMiddle                 ' 縦方向中央揃え
            .TextRange.Text = eventname                       ' 表示文字
            .TextRange.ParagraphFormat.Alignment = msoAlignCenter ' 横方向中央揃え

            ' フォント設定
            With .TextRange.Font
                .Name = "Meiryo UI"
                .Size = 11
                .Bold = True
                .Fill.ForeColor.RGB = RGB(0, 0, 0)            ' 文字色：黒
            End With
        End With

        '-----------------------------------------
        ' 次の図形の配置位置を少しずらす
        ' （右下方向に10pxずつ移動）
        '-----------------------------------------
        originx = originx + 10
        originy = originy + 10

CONTINUE:

    Next i

End Sub

工夫した点

検討して大枠の動作が出来た段階で思ったのが、

１．大きさが調整出来たらよい
　　　小さいと動かしづらかった。
２．色分けできるとよい
　　　全部同じ色だけだと直感的に分かりづらい。
という所だったので、それぞれ後から処理や設定を持たせるように追加を行った。

その他

プログラム動作のカット＆トライを重ねると、どんどんオートシェイプが溜まっていき作ったオートシェイプを削除するのが手間だった。
ということでオートシェイプを削除するマクロも用意した。

J1セルより右側にあるオートシェイプを削除する。

Sub DeleteShapes()

Dim a As Shape

For Each a In ActiveSheet.Shapes
        '図形を選択
        If a.Left > Range("J1").Left Then
            a.Delete
        End If

Next
End Sub

※マクロで削除した場合はCtrl＋Zで戻れないので注意

初めはオートシェイプを全部消す処理にしたのだが、”オートシェイプ作成”　のボタンも消えてしまったので処理を変えた。。

以上。