【EXCEL】図形挿入のマクロメモ

# やること
　EXCELで同じような図形挿入に対するメモをまとめておく。

# 事前確認：Qiitaでの記事
　ここで、以下の検索をしたところ、60件ヒットした。(2024/10/27時点)
[「EXCEL　VBA　図形挿入」の検索結果 - Qiita](https://qiita.com/search?q=EXCEL%E3%80%80VBA%E3%80%80%E5%9B%B3%E5%BD%A2%E6%8C%BF%E5%85%A5)

　以下、6種類(8件)紹介。

# 赤枠背景透明図形を挿入するマクロ
 [VBAでプロシージャを部品（パーツ）化して使う #Excel - Qiita](https://qiita.com/nanashi0424/items/4b3e9edd5d42bbf22a9d)
 最終更新日 2024年10月20日　投稿日 2024年10月08日
[個人マクロブック等に保存して利用するVBAの汎用プロシージャ7選 #Excel - Qiita](https://qiita.com/nanashi0424/items/709b58f422860bbbef30)
 最終更新日 2024年10月26日　投稿日 2024年10月10日
　よく使う、標準の図形にはないものをVBAで作成し、複数ブックで使いまわす。

# ダブルクリックで自動作成
[[ExcelVBA]吹き出しをダブルクリックで自動作成 #図形 - Qiita](https://qiita.com/kazuya999/items/31333e93687ccf0673f0)
 投稿日 2023年04月09日
　タイトルの通り。吹き出しのNo.付けを含む。

# Shape オブジェクト
 [ExcelVBAマクロのチートシート #Excel - Qiita](https://qiita.com/yikemac/items/68413ab07509c292c615)
 最終更新日 2022年05月11日 投稿日 2022年05月03日
　よく使う情報をDebug.Printで表示。

# 無効な図形オブジェクトを一括削除
[ひとり情シスに役立つVBAコードのサンプル #tips - Qiita](https://qiita.com/mindwood/items/a2145769d6b626c1f8ee)
 最終更新日 2019年06月18日 投稿日 2019年05月07日
　図形の幅や高さがゼロのオブジェクトを削除。

[JTCやコンサルで代々引き継がれてきたブックにありがちなこと #Excel - Qiita](https://qiita.com/nanashi0424/items/31b032e55c37d89d5a3e)
最終更新日 2024年10月27日　投稿日 2024年10月27日
　こちらも「高さ・幅が０で視認できない図形」の削除など。

# テーブル上の値に合わせて図形の色が変更される
 [Excelテーブルから図形の色を変更し、社内の空調設備を視覚化する #ExcelVBA - Qiita](https://qiita.com/woria1517/items/e5125b25e8d79475792b)
　最終更新日 2023年07月18日　投稿日 2023年07月12日
 　テーブル上の値に合わせて図形の色が変更されるVBA。

# フローチャート作成
[エクセルシートからチャート #Excel - Qiita](https://qiita.com/momoyamas/items/19cf853a2fa3b06c0588)
　投稿日 2021年09月23日
　エクセルのセル情報から、チャート（フローチャート）を半自動的で作成。

# (Qiita以外)テキストボックス関連
[Excel VBA（マクロ）でテキストボックスを作成する方法/AddTextBoxメソッドの使い方 | すなぎつ](https://sunagitsune.com/excelvbaaddtextbox/)
　2021.12.01　2021.11.23
[Excel（エクセル）でセルの内容をテキストボックスに表示する方法 | すなぎつ](https://sunagitsune.com/excelcelltotextbox/)
　2021.05.19　2021.04.24
[テキストボックスにセルの値を表示する | Excelのコト](https://excelnokoto.com/2019/09/03/mitame/367/)
　公開日2019年9月3日　最終更新日2020年2月7日
 [【VBA】図形やテキストボックスを挿入して作成【AddShapeとAddTextboxを使う】](https://daitaideit.com/vba-addshape-addtextbox/)
 　2021/4/4

# おまけ:付箋作成
　[【EXCEL】カレンダーづくり(Write Only Code) #初心者 - Qiita](https://qiita.com/a_kata/items/589aebb1fab4d4aa8d49)　に、付箋を追加する例。

```vb:付箋作成.bas 
Option Explicit
    '-----付箋追加-----
    ' 【EXCEL】カレンダーづくり(Write Only Code) #初心者 - Qiita
    '  https://qiita.com/a_kata/items/589aebb1fab4d4aa8d49
    ' に付箋を追加する。

Sub 付箋追加テスト()
    Dim ws As Worksheet
    Dim shp As Shape
    Range("C6").Activate                                    '以下アクティブセル対応にしたので仮置き
    Set ws = Worksheets("壱ヶ月カレンダー")
    Set shp = ws.Shapes.AddShape(msoShapeFoldedCorner, _
                        ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height)
        shp.Line.Weight = 2
        shp.TextFrame.Characters.Font.Size = 10             ' 文字サイズ
        shp.Line.ForeColor.RGB = RGB(0, 0, 0)               ' 枠を黒
'        shp.Fill.ForeColor.RGB = RGB(209, 227, 246)         ' 青
'        shp.Fill.ForeColor.RGB = RGB(215, 237, 216)         ' 緑
'        shp.Fill.ForeColor.RGB = RGB(252, 217, 222)         ' 赤
        shp.Fill.ForeColor.RGB = RGB(255, 244, 125)         ' 黄
        shp.TextFrame.Characters.Font.Color = RGB(0, 0, 0)  ' 文字色
        shp.Name = "F-" & get_new_number(ws)                ' 図形名を「四角形: メモ *」から「F-*」に変更
End Sub

Function get_new_number(ws As Worksheet) As Integer
    '----- get_new_number -----
    ' 新規付箋NO.の取得(歯抜けは不問)
    ' 引数
    '   Worksheet           検査したいワークシート
    ' 返り値
    '                       使用されている一番大きな番号+1
    Dim shp As Shape
    Dim i As Integer
    Dim s As String
    Dim F_num As Integer                                        ' 使用されている一番大きな番号用
        F_num = 0                                               ' 0からスタート("+1"して戻すため)
    For Each shp In ws.Shapes
        If shp.Type = msoAutoShape Then
            If shp.AutoShapeType = msoShapeFoldedCorner Then    ' msoShapeFoldedCorner : メモ(新規作成分を含む)
                i = InStr(shp.Name, "F-")                       ' "F-"の文字位置(新規は"Folded Corner *")
                If i > 0 Then                                   ' ->基本"1"になるはず
                    s = Mid(shp.Name, i + 2)                    ' "F-"をのぞいた文字列
                    If IsNumeric(s) Then                        ' ->基本数字となるはず
                        i = CInt(s)
                        If i > F_num Then
                            F_num = i
                        End If
                    End If
                End If
            End If
        End If
    Next
    get_new_number = F_num + 1
End Function
```

<details><summary>(追記：完成形)</summary>

![20250423_002000.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3838258/ac76f6ac-29c6-4f65-b629-507827eaf87d.jpeg)

セルC6に付箋紙を追加😅
</details>