同じタイプのオートシェイプを選択するマクロ
2021年10月14日
最近夜更かしで寝不足気味。
夜にパソコンやるのよくないと分かってるけど、
ついつい手を伸ばしちゃう。自律ルールを作るかな。
今回もまたオートシェイプの話。
オートシェイプの枠線の太さや塗りつぶしの色の変更を
一括でできると便利だよね。
２つ目以降の変更をF4キーでやってくにしても
数が多いとやっぱりめんどい。
ただ、マクロで実行しちゃうとUnDoが使えないので、
オートシェイプのタイプが同じものを選択するマクロを作ってみた。
汎用性を考えて、複数のシェイプを選択した場合は
いずれかのシェイプタイプと同じなら選択する。
処理の流れは以下のステップ
１．シェイプを選択してなかったらエラーにする。
２．選択中の全シェイプに対してループさせる。
３．シェイプタイプを調べ辞書に格納する。
４．シート内の全シェイプに対してループさせる。
５．辞書に登録済みのシェイプタイプなら選択する。
６．結果をメッセージボックスに出力
今回は簡単なので、以下ソース。
夜にパソコンやるのよくないと分かってるけど、
ついつい手を伸ばしちゃう。自律ルールを作るかな。
今回もまたオートシェイプの話。
オートシェイプの枠線の太さや塗りつぶしの色の変更を
一括でできると便利だよね。
２つ目以降の変更をF4キーでやってくにしても
数が多いとやっぱりめんどい。
ただ、マクロで実行しちゃうとUnDoが使えないので、
オートシェイプのタイプが同じものを選択するマクロを作ってみた。
汎用性を考えて、複数のシェイプを選択した場合は
いずれかのシェイプタイプと同じなら選択する。
処理の流れは以下のステップ
１．シェイプを選択してなかったらエラーにする。
２．選択中の全シェイプに対してループさせる。
３．シェイプタイプを調べ辞書に格納する。
４．シート内の全シェイプに対してループさせる。
５．辞書に登録済みのシェイプタイプなら選択する。
６．結果をメッセージボックスに出力
今回は簡単なので、以下ソース。
Sub ◆Select_SameShapeType()
If VarType(Selection) <> vbObject Then 'https://www.relief.jp/docs/excel-vba-check-if-shape-selected.html
MsgBox "オートシェイプを選択してください."
Exit Sub
End If
On Error Resume Next
Dim DicT: Set DicT = CreateObject("Scripting.Dictionary")
Dim shpType As Long, Shp As Shape
For Each Shp In Selection.ShapeRange
shpType = Shp.AutoShapeType
If DicT.exists(shpType) Then
Else
DicT.Add shpType, 0
End If
Next Shp
Dim typeList: typeList = DicT.keys: DicT = Nothing
Dim i As Long, cnt As Long
For Each Shp In ActiveSheet.Shapes
shpType = Shp.AutoShapeType
For i = 0 To UBound(typeList)
If typeList(i) = shpType Then Shp.Select Replace:=False
cnt = cnt + 1
Next i
Next Shp
Dim msgText As String, shpt As Long
msgText = "以下のタイプのオートシェイプ" & cnt & "個を選択しました。"
For i = 0 To UBound(typeList)
shpt = typeList(i)
msgText = msgText & Chr(10) & "(" & i + 1 & ") " & typeList(i) & ":" & ★strAutoShapeType(shpt)
Next i
MsgBox msgText, , "要 線種確認"
End Sub
Function ★strAutoShapeType(n As Long)
Select Case n
Case 1: ★strAutoShapeType = "四角形"
Case 2: ★strAutoShapeType = "平行四辺形"
Case 3: ★strAutoShapeType = "台形"
Case 4: ★strAutoShapeType = "ひし形"
Case 5: ★strAutoShapeType = "角丸四角形"
Case 6: ★strAutoShapeType = "八角形"
Case 7: ★strAutoShapeType = "二等辺三角形"
Case 8: ★strAutoShapeType = "直角三角形"
Case 9: ★strAutoShapeType = "楕円"
Case 10: ★strAutoShapeType = "六角形"
Case 11: ★strAutoShapeType = "十字形"
Case 12: ★strAutoShapeType = "ホームベース"
Case 13: ★strAutoShapeType = "円柱"
Case 14: ★strAutoShapeType = "直方体"
Case 15: ★strAutoShapeType = "斜角"
Case 16: ★strAutoShapeType = "メモ"
Case 17: ★strAutoShapeType = "スマイル"
Case 18: ★strAutoShapeType = "ドーナツ"
Case 19: ★strAutoShapeType = "禁止"
Case 20: ★strAutoShapeType = "アーチ"
Case 21: ★strAutoShapeType = "ハート"
Case 22: ★strAutoShapeType = "稲妻"
Case 23: ★strAutoShapeType = "太陽"
Case 24: ★strAutoShapeType = "月"
Case 25: ★strAutoShapeType = "円弧"
Case 26: ★strAutoShapeType = "大かっこ"
Case 27: ★strAutoShapeType = "中かっこ"
Case 28: ★strAutoShapeType = "ブローチ"
Case 29: ★strAutoShapeType = "左大かっこ"
Case 30: ★strAutoShapeType = "右大かっこ"
Case 31: ★strAutoShapeType = "左中かっこ"
Case 32: ★strAutoShapeType = "右中かっこ"
Case 33: ★strAutoShapeType = "右向きブロック矢印"
Case 34: ★strAutoShapeType = "左向きブロック矢印"
Case 35: ★strAutoShapeType = "上向きブロック矢印"
Case 36: ★strAutoShapeType = "下向きブロック矢印"
Case 37: ★strAutoShapeType = "左右ブロック矢印"
Case 38: ★strAutoShapeType = "上下 2 方向ブロック矢印"
Case 39: ★strAutoShapeType = "4 方向ブロック矢印"
Case 40: ★strAutoShapeType = "左、右、および上の 3 方向ブロック矢印"
Case 41: ★strAutoShapeType = "90°の曲線に続くブロック矢印"
Case 42: ★strAutoShapeType = "U 字型のブロック矢印"
Case 43: ★strAutoShapeType = "左および上矢印の 2 方向ブロック矢印"
Case 44: ★strAutoShapeType = "90°の鋭角線に続くブロック矢印既定では上向きです"
Case 45: ★strAutoShapeType = "右カーブ ブロック矢印"
Case 46: ★strAutoShapeType = "左カーブ ブロック矢印"
Case 47: ★strAutoShapeType = "上カーブ ブロック矢印"
Case 48: ★strAutoShapeType = "下カーブ ブロック矢印"
Case 49: ★strAutoShapeType = "先にストライプの付いた右向きのブロック矢印"
Case 50: ★strAutoShapeType = "右向きの V 字型矢印"
Case 51: ★strAutoShapeType = "ホームベース"
Case 52: ★strAutoShapeType = "山形"
Case 53: ★strAutoShapeType = "右矢印の付いた吹き出し"
Case 54: ★strAutoShapeType = "左矢印の付いた吹き出し"
Case 55: ★strAutoShapeType = "上矢印の付いた吹き出し"
Case 56: ★strAutoShapeType = "下矢印の付いた吹き出し"
Case 57: ★strAutoShapeType = "左右矢印の付いた吹き出し"
Case 58: ★strAutoShapeType = "上下のブロック矢印の付いた吹き出し"
Case 59: ★strAutoShapeType = "4 方向矢印の付いた吹き出し"
Case 60: ★strAutoShapeType = "180°の曲線に続くブロック矢印"
Case 61: ★strAutoShapeType = "フローチャート 処理"
Case 62: ★strAutoShapeType = "フローチャート 代替処理"
Case 63: ★strAutoShapeType = "フローチャート 判断"
Case 64: ★strAutoShapeType = "フローチャート データ"
Case 65: ★strAutoShapeType = "フローチャート 定義済み処理"
Case 66: ★strAutoShapeType = "フローチャート 内部記憶"
Case 67: ★strAutoShapeType = "フローチャート 書類"
Case 68: ★strAutoShapeType = "フローチャート 複数書類"
Case 69: ★strAutoShapeType = "フローチャート 端子"
Case 70: ★strAutoShapeType = "フローチャート 準備"
Case 71: ★strAutoShapeType = "フローチャート 手操作入力"
Case 72: ★strAutoShapeType = "フローチャート 手作業"
Case 73: ★strAutoShapeType = "フローチャート 結合子"
Case 74: ★strAutoShapeType = "フローチャート 他ページ結合子"
Case 75: ★strAutoShapeType = "フローチャート カード"
Case 76: ★strAutoShapeType = "フローチャート せん孔テープ"
Case 77: ★strAutoShapeType = "フローチャート 和接合"
Case 78: ★strAutoShapeType = "フローチャート 論理和"
Case 79: ★strAutoShapeType = "フローチャート 照合"
Case 80: ★strAutoShapeType = "フローチャート 分類"
Case 81: ★strAutoShapeType = "フローチャート 抜き出し"
Case 82: ★strAutoShapeType = "フローチャート 組み合わせ"
Case 83: ★strAutoShapeType = "フローチャート 記憶データ"
Case 84: ★strAutoShapeType = "フローチャート 論理積ゲート"
Case 85: ★strAutoShapeType = "フローチャート 順次アクセス記憶"
Case 86: ★strAutoShapeType = "フローチャート 磁気ディスク"
Case 87: ★strAutoShapeType = "フローチャート 直接アクセス記憶"
Case 88: ★strAutoShapeType = "フローチャート 表示"
Case 89: ★strAutoShapeType = "爆発 1"
Case 90: ★strAutoShapeType = "爆発 2"
Case 91: ★strAutoShapeType = "星 4"
Case 92: ★strAutoShapeType = "星 5"
Case 93: ★strAutoShapeType = "星 8"
Case 94: ★strAutoShapeType = "星 16"
Case 95: ★strAutoShapeType = "星 24"
Case 96: ★strAutoShapeType = "星 32"
Case 97: ★strAutoShapeType = "リボンの端よりも上に中央面があるリボン"
Case 98: ★strAutoShapeType = "リボンの端よりも下に中央面があるリボン"
Case 99: ★strAutoShapeType = "上カーブリボン"
Case 100: ★strAutoShapeType = "下カーブ リボン"
Case 101: ★strAutoShapeType = "縦巻き"
Case 102: ★strAutoShapeType = "横巻き"
Case 103: ★strAutoShapeType = "大波"
Case 104: ★strAutoShapeType = "小波"
Case 105: ★strAutoShapeType = "四角形吹き出し"
Case 106: ★strAutoShapeType = "角丸四角形吹き出し"
Case 107: ★strAutoShapeType = "円形吹き出し"
Case 108: ★strAutoShapeType = "雲形吹き出し"
Case 109: ★strAutoShapeType = "枠付きで、水平の吹き出し線の付いた吹き出し"
Case 110: ★strAutoShapeType = "斜めの直線の付いた吹き出し"
Case 111: ★strAutoShapeType = "折れ線の付いた吹き出し"
Case 112: ★strAutoShapeType = "U 字型の吹き出し線分の付いた吹き出し"
Case 113: ★strAutoShapeType = "水平の強調線の付いた吹き出し"
Case 114: ★strAutoShapeType = "斜めの吹き出し線と強調線の付いた吹き出し"
Case 115: ★strAutoShapeType = "折れた吹き出し線と強調線の付いた吹き出し"
Case 116: ★strAutoShapeType = "強調線および U 字型の吹き出し線分の付いた吹き出し"
Case 117: ★strAutoShapeType = "水平線の付いた吹き出し"
Case 118: ★strAutoShapeType = "枠および斜めの吹き出し線のない吹き出し"
Case 119: ★strAutoShapeType = "枠および折れた吹き出し線のない吹き出し"
Case 120: ★strAutoShapeType = "枠線および U 字型の吹き出し線分のない呼び出し"
Case 121: ★strAutoShapeType = "枠付きで、水平の強調線の付いた吹き出し"
Case 122: ★strAutoShapeType = "枠、斜めの直線、および強調線の付いた吹き出し"
Case 123: ★strAutoShapeType = "枠、折れた吹き出し線、強調線の付いた吹き出し"
Case 124: ★strAutoShapeType = "枠線、強調線、および U 字型の吹き出し線分の付いた吹き出し"
Case 125: ★strAutoShapeType = "既定の画像またはテキストのないボタンマウスクリックおよびマウスオーバー動作をサポートします"
Case 126: ★strAutoShapeType = "[ホーム] ボタンマウスクリックおよびマウスオーバー動作をサポートします"
Case 127: ★strAutoShapeType = "[ヘルプ] ボタンマウスクリックおよびマウスオーバー動作をサポートします"
Case 128: ★strAutoShapeType = "[情報] ボタンマウスクリックおよびマウスオーバー動作をサポートします"
Case 129: ★strAutoShapeType = "[戻る] または [前へ] ボタンマウスクリックおよびマウスオーバー動作をサポートします"
Case 130: ★strAutoShapeType = "[進む] または [次へ] ボタンマウスクリックおよびマウスオーバー動作をサポートします"
Case 131: ★strAutoShapeType = "[上旬] ボタンマウスクリックおよびマウスオーバー動作をサポートします"
Case 132: ★strAutoShapeType = "[終了] ボタンマウスクリックおよびマウスオーバー動作をサポートします"
Case 133: ★strAutoShapeType = "[戻る] ボタンマウスクリックおよびマウスオーバー動作をサポートします"
Case 134: ★strAutoShapeType = "[文書] ボタンマウスクリックおよびマウスオーバー動作をサポートします"
Case 135: ★strAutoShapeType = "[サウンド] ボタンマウスクリックおよびマウスオーバー動作をサポートします"
Case 136: ★strAutoShapeType = "[ビデオ] ボタンマウスクリックおよびマウスオーバー動作をサポートします"
Case 137: ★strAutoShapeType = "吹き出し"
Case 138: ★strAutoShapeType = "サポートされません"
Case 139: ★strAutoShapeType = "オフラインの記憶フローチャート記号"
Case 140: ★strAutoShapeType = "リボンの両端に矢印の付いた"
Case 141: ★strAutoShapeType = "四角形に 2 つの三角形図形を削除します斜めのストライプ"
Case 142: ★strAutoShapeType = "円 (円) で不足している部分です"
Case 143: ★strAutoShapeType = "非対称非平行辺の台形を塗りつぶす"
Case 144: ★strAutoShapeType = "Decagon"
Case 145: ★strAutoShapeType = "七角形です"
Case 146: ★strAutoShapeType = "Dodecagon"
Case 147: ★strAutoShapeType = "6 ポイントの星型です"
Case 148: ★strAutoShapeType = "7 番ポイントの星型です"
Case 149: ★strAutoShapeType = "10 ポイントの星型です"
Case 150: ★strAutoShapeType = "12 ポイントの星型です"
Case 151: ★strAutoShapeType = "1 つの丸い角を持つ四角形"
Case 152: ★strAutoShapeType = "2 つの丸められた角の辺を共有する四角形"
Case 154: ★strAutoShapeType = "スニペットの角の 1 つと 1 つの丸い角を持つ四角形"
Case 155: ★strAutoShapeType = "スニペットのいずれかの角を持つ四角形"
Case 156: ★strAutoShapeType = "辺を共有する 2 つのスニペットの角を持つ四角形"
Case 157: ★strAutoShapeType = "斜めにではなく、2 つの丸い角を持つ四角形"
Case 157: ★strAutoShapeType = "斜めにではなく、2 つのスニペット角を持つ四角形"
Case 158: ★strAutoShapeType = "長方形の画像フレーム"
Case 159: ★strAutoShapeType = "四角形の図枠の半分です"
Case 160: ★strAutoShapeType = "ドロップレットの水"
Case 161: ★strAutoShapeType = "円は、円の内部を外周上の 2 点を結ぶ直線弦を持つ円"
Case 162: ★strAutoShapeType = "四角形の穴を持つ四角形"
Case 163: ★strAutoShapeType = "加算記号 ‘＋’"
Case 164: ★strAutoShapeType = "減算記号 ‘－’"
Case 165: ★strAutoShapeType = "乗算記号 ‘×’"
Case 166: ★strAutoShapeType = "除算記号 ‘÷’"
Case 167: ★strAutoShapeType = "等価性の記号 ‘ =’ です"
Case 168: ★strAutoShapeType = "非等価記号 ‘≠’ です"
Case 169: ★strAutoShapeType = "4 つの右の三角形が四角形のパスに沿って整列4 つの ‘スニペット’ 角"
Case 170: ★strAutoShapeType = "4 小さい正方形、四角形を定義します"
Case 171: ★strAutoShapeType = "4 四半期の円、四角形を定義します"
Case 172: ★strAutoShapeType = "六つの歯の装置です"
Case 173: ★strAutoShapeType = "9 つの歯の装置"
Case 174: ★strAutoShapeType = "Funnel"
Case 175: ★strAutoShapeType = "円の図形の四半期です"
Case 176: ★strAutoShapeType = "円形矢印反時計回りに"
Case 177: ★strAutoShapeType = "円形矢印時計回りと反時計回りに両方の端点と曲線の矢印です"
Case 178: ★strAutoShapeType = "曲線の矢印です"
Case 179: ★strAutoShapeType = "雲の形です"
Case 180: ★strAutoShapeType = "正方形は対角線に沿って 4 つの部分に分割されます"
Case 181: ★strAutoShapeType = "垂直および斜めの線に沿って、6 つの部分を四角形に分割されます"
Case 182: ★strAutoShapeType = "正方形は 4 つの四半期に垂直方向と水平方向に分かれています"
Case 183: ★strAutoShapeType = "行を反転します"
Case -2: ★strAutoShapeType = "戻り値のみ（他の状態の組み合わせを指定）"
End Select
End Function
PR
Comment