Excel VBAのコーディング事例をご紹介しています。
事例のテーマを決めて、その機能を実現するためのコーディングを動く形でお示して行きます。
今回はShapeオブジェクトのNameプロパティーを取得した時、図形名を変更していない場合は英語表記が返されるのですが、これを「オブジェクトの選択と表示」で表示される日本語名に翻訳(変換)するコーディングをご紹介したく存じます。
なおコーディング自体は「構造化・標準化は考慮しつつも極力コーディング量は減らし、その上で可読性を維持する」という思いは持ちつつも「テーマに沿って動くことを優先して実装」しています。
Excel バージョン2112(ビルド 14729.20260)を使用しています。
オートシェープ図形の一覧表を作成する
翻訳するためにはすべてのオートシェープ図形の図形名を集める必要があります。
オートシェープ図形は挿入タブメニューの図グループにある図形からシートに配置する事ができますが、設定されているアイコンの数を数えると全部で161種類ある事が解ります。
まずはこれらの図形をすべてシートに配置して行きます。
配置し終えたら、ホームタブメニューの編集グループの中の「検索と選択」プルダウンメニューから「オブジェクトの選択と表示」をクリックします。
図形の日本語名を取得するには
「選択」サブウインドウが開き、その中に配置したすべてのオートシェープ図形の図形名が日本語で表示されています。
図形を1つ選択すると名前ボックス(左図赤枠)に同様に図形の名前が表示されますが、すべての図形の図形名を見るには「選択」サブウインドウの方が便利です。
余談になりますが、図形を1つ選択した状態で「選択」サブウインドウで「ctrlキー + Aボタン」を押すとシート上のすべてのオブジェクトを選択する事ができます。すべての図形を選択する際に有効です。
日本語名は「選択」サブウインドウに表示されている図形名の1つをクリックするとシート上の図形が選択されますが、ダブルクリックすると図形名を編集するモードに切り替わます。この状態で日本語名を範囲選択して取得します。ここは地道に一つずつ処理するしか方法が無さそうです。
なお図形名にはオートシェープ図形の図形名の後に、1半角スペースを空けて数値が付番されています。
一応デフォルトでは図形名がユニークになるように数値が付番されるのですが、実は図形名は編集モードで同じ名前に付け替える事ができます。
つまり図形名は「必ずユニークである」とは言えません。
この辺りは後段でご説明するVBAコーディンクでの仕様に関係がありますので、頭の片隅に留めていただければ幸いです。
VBAで図形の名前を取得する
VBAでアクティブシート上のすべてのオブジェクト名を取得するためには下記のようなコードを実行する必要があります。結果はイミディエイトウィンドウに出力されます。
Sub shapesname()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
Debug.Print shp.Name
Next
End Sub
図形の英語名はこれで一気に収集することができます。
日本語名と英語名の対比表を作る
161種類すべての日本語名と英語名が揃ったので、次に変換に必要な対比表を作成して行きます。
下記ExcelシートはMicrosoftサポートの「OneDrive から Web ページやブログに Excel ブックを埋め込む」に基づきOneDrive「https://onedrive.live.com」にアクセスして表示しています。
※iframeを使用しています。
対比表で灰色背景の図形は図形名が重複している事が解ります。これらの重複を除いて行くと結果的に153種類の図形名が残ります。従いましてこれを元に英語から日本語に変換するコーディングを行えば良い事になります。
ただ、その前に複数の図形をグループ化した時の動きを確認する必要があります。
グループ化した図形の場合
図形をグループ化した時の動きを確認します。
楕円と二等辺三角形の2つの図形を選択してグループ化してみます。
選択サブウインドウを見ると親として「グループ化」という図形名が付与されている事が解ります。
ここで先の章で使ったコーディングを実行するとイミディエイトウィンドウには次のように表示されます。
これによりグループ化された図形はGroupと変換すれば良い事が解ります。
[余談]グループ化した子供の図形名をVBAで表示するには
選択サブウインドウにはグループ化した図形の子図形が表示されていますがVBAではGroupとしか捉えられないのでしょうか?
いえいえ、そんなことはありません。VBAではグループ化した図形の子供の図形はGroupItemsプロパティを使って取得する事ができます。
先の章のコーディングにGroupItemsプロパティを追加して子供の図形名を表示させて見ます。
※「グループ化した図形」という条件があるので5行目のIF文を設定しています。
Sub shapesname()
Dim shp As Shape, childshp As Shape
For Each shp In ActiveSheet.Shapes
Debug.Print shp.Name
If shp.Type = msoGroup Then
For Each childshp In shp.GroupItems
Debug.Print childshp.Name
Next
End If
Next
End Sub
イミディエイトウィンドウには次のように表示されます。
選択サブウインドウで図形名を変更した時のVBAの図形名
先の章で「選択」サブウインドウに表示されている図形名をダブルクリックすると図形名を編集するモードに切り替わるお話はしましたが、前章で使用したシートで実際に図形名を変更した時のVBAでの動きを確認します。
下記のように「楕円」以外を変更します。
- 「ブロック化 3」を「人物」
- 「二等辺三角形 2」を「体」
前章でご紹介したVBAを実行するとイミディエイトウィンドウには左図のように出力されます。
VBAでの動きは恐らく下記のようになっていると推察されます。
- 変更入力された図形名は変更された名前を出力
- 変更入力されなかった図形名はデフォルトの英語になる。
- 「選択」サブウインドウでは日本語名を表示
以上の結果から対比表に存在しない図形名は変更された図形名としてそのままにしておくのが良さそうです。
図形名を日本語に変換する
VBAの処理の中で、図形名(Shape.Name)を引数として受け取り対比表に基づき日本語名を返す関数(Function)を作成します。
まずは関数の仕様のポイントについてご説明いたします。
①引数にはShape.Nameの値がそのままセットされる事を想定する
図形名が変更されていれば「変更された値」が、デフォルトのままであれば「英語名+半角スペース+連番」が引数にセットされているものとします。
その上で、InStrRev関数を使って引数の中にある半角スペースを右端から探して最初に見つかった左端からの位置で右と左に分けて、半角スペースを考慮した上で左側は図形名、右側は連番と仮定して左側の図形名が対比表英語に存在するかどうかを確認します。
半角スペースが見つからなかった時は引数そのものが対比表英語に存在するかどうかを確認します。
図形名がどのように変更されているか?は解らないのでデフォルトのフォーマットを判断の拠り所にしています。
従って引数にはShape.Nameの値がそのままセットされていて欲しいのですが、「連番」だけ削除されて来た場合でも変換の対象になるように考慮します。
②Filter関数を使用して引数が対比表の英語に存在するか検索する
まずはFilter関数のOffice VBA リファレンスでの説明を確認します。なおもっと分かり易い説明のサイトがGoogle検索をすると見つかるのでそちらも併せてご確認いただければ幸いです。
指定されたフィルター条件に基づいて、文字列配列のサブセットが含まれるゼロベース配列を返します。
難解な表現ではありますが、「検索対象の文字列から検索文字列が含まれる添え字がゼロから始まる配列を返します」という内容になります。
「構文」の指定項目の説明で「sourcearray」は”検索する文字列の1次元配列”と書かれているので配列は1次元に限定されています。
また省略可能な「include」指定項目の説明に”返すサブ文字列”という表現があるので、Filter関数の検索は部分一致である事が解ります。
対比表の英語を1次元配列に加工する
加工に際して下記の留意点があります。
- 1次元配列という事は、そのまま加工しただけでは「Shape.Nameの値が配列の中に部分一致で該当する項目を抜き出す」事しかできません。つまりは日本語に変換する事ができません。
- また部分一致ということは、もしも図形名が英字1文字に変更されていた場合は数多くの項目がヒットしてしまうことになります。
「1.」を解決するために、配列項目のデータは「Shape.Nameの値」に「対比表のNo」をつなぎ合わせた値にします。
日本語名は対比表のNoは1から付番しているので、実際に使う時には「-1」するものとします。
日本語名配列の作り方をゼロベース配列ではなく「1」から始まるようにすれば「-1」しなくても済むのですが、今回は「Shape.Nameの値(英語名)」の配列、検索結果の配列、日本語の配列の3つ全てをゼロベース配列に統一していますのでお含み置きください。
「2.」を解決するためにShape.Nameの値(英語名)を後ろに半角スペースを付けて固定長にしてセットする事にします。
そうなると当然関数に渡される引数も連番を除いた後に半角スペースを付けて同じ長さの固定長にする必要があります。
こうしないと複数ヒットしてしまう可能性がありますので致し方無い認識です。
対比表の日本語名を1次元配列にセットする
前章でもご説明しましたがゼロベース配列として、並びは「対比表のNo」にします。
なお配列にセットする際にVBAのコーディングでは行連結文字で結合できる行数には制限があるために横スクロールが必要な長さまで使用していますのでお含み置きいただければ幸いです。
実際のコーディング
Public Function changeEngToJpn(stTarget As String) As String
Dim st_text1 As String, st_text2 As String
Dim v_Eng As Variant, v_Jpn As Variant, st_buf() As String
Dim id As Integer
Const iMax As Integer = 39 '固定長の長さ
v_Eng = Array("Straight Connector 001", "Straight Arrow Connector 002", "Elbow Connector 003", "Curved Connector 004", "Freeform 005", "Rectangle 006", "Rounded Rectangle 007", "Snip Single Corner Rectangle 008", "Snip Same Side Corner Rectangle 009", "Snip Diagonal Corner Rectangle 010", _
"Snip and Round Single Corner Rectangle 011", "Round Single Corner Rectangle 012", "Round Same Side Corner Rectangle 013", "Round Diagonal Corner Rectangle 014", "TextBox 015", "Oval 016", "Isosceles Triangle 017", "Right Triangle 018", "Parallelogram 019", "Trapezoid 020", _
"Diamond 021", "Regular Pentagon 022", "Hexagon 023", "Heptagon 024", "Octagon 025", "Decagon 026", "Dodecagon 027", "Pie 028", "Chord 029", "Teardrop 030", _
"Frame 031", "Half Frame 032", "L-Shape 033", "Diagonal Stripe 034", "Cross 035", "Plaque 036", "Can 037", "Cube 038", "Bevel 039", "Donut 040", _
"No Symbol 041", "Block Arc 042", "Folded Corner 043", "Smiley Face 044", "Heart 045", "Lightning Bolt 046", "Sun 047", "Moon 048", "Cloud 049", "Arc 050", _
"Double Bracket 051", "Double Brace 052", "Left Bracket 053", "Right Bracket 054", "Left Brace 055", "Right Brace 056", "Right Arrow 057", "Left Arrow 058", "Up Arrow 059", "Down Arrow 060", _
"Left-Right Arrow 061", "Up-Down Arrow 062", "Quad Arrow 063", "Left-Right-Up Arrow 064", "Bent Arrow 065", "U-Turn Arrow 066", "Left-Up Arrow 067", "Bent-Up Arrow 068", "Curved Right Arrow 069", "Curved Left Arrow 070", _
"Curved Up Arrow 071", "Curved Down Arrow 072", "Striped Right Arrow 073", "Notched Right Arrow 074", "Pentagon 075", "Chevron 076", "Right Arrow Callout 077", "Down Arrow Callout 078", "Left Arrow Callout 079", "Up Arrow Callout 080", _
"Left-Right Arrow Callout 081", "Quad Arrow Callout 082", "Circular Arrow 083", "Plus 084", "Minus 085", "Multiply 086", "Division 087", "Equal 088", "Not Equal 089", "Flowchart: Process 090", _
"Flowchart: Alternate Process 091", "Flowchart: Decision 092", "Flowchart: Data 093", "Flowchart: Predefined Process 094", "Flowchart: Internal Storage 095", "Flowchart: Document 096", "Flowchart: Multidocument 097", "Flowchart: Terminator 098", "Flowchart: Preparation 099", "Flowchart: Manual Input 100", _
"Flowchart: Manual Operation 101", "Flowchart: Connector 102", "Flowchart: Off-page Connector 103", "Flowchart: Card 104", "Flowchart: Punched Tape 105", "Flowchart: Summing Junction 106", "Flowchart: Or 107", "Flowchart: Collate 108", "Flowchart: Sort 109", "Flowchart: Extract 110", _
"Flowchart: Merge 111", "Flowchart: Stored Data 112", "Flowchart: Delay 113", "Flowchart: Sequential Access Storage 114", "Flowchart: Magnetic Disk 115", "Flowchart: Direct Access Storage 116", "Flowchart: Display 117", "Explosion 1 118", "Explosion 2 119", "4-Point Star 120", _
"5-Point Star 121", "6-Point Star 122", "7-Point Star 123", "8-Point Star 124", "10-Point Star 125", "12-Point Star 126", "16-Point Star 127", "24-Point Star 128", "32-Point Star 129", "Up Ribbon 130", _
"Down Ribbon 131", "Curved Up Ribbon 132", "Curved Down Ribbon 133", "Vertical Scroll 134", "Horizontal Scroll 135", "Wave 136", "Double Wave 137", "Rectangular Callout 138", "Rounded Rectangular Callout 139", "Oval Callout 140", _
"Cloud Callout 141", "Line Callout 1 142", "Line Callout 2 143", "Line Callout 3 144", "Line Callout 1 (Accent Bar) 145", "Line Callout 2 (Accent Bar) 146", "Line Callout 3 (Accent Bar) 147", "Line Callout 1 (No Border) 148", "Line Callout 2 (No Border) 149", "Line Callout 3 (No Border) 150", _
"Line Callout 1 (Border and Accent Bar) 151", "Line Callout 2 (Border and Accent Bar) 152", "Line Callout 3 (Border and Accent Bar) 153", "Group 154")
If InStrRev(stTarget, " ") = 0 Then '連番が付番されていない場合
st_text1 = stTarget
st_text2 = ""
Else
st_text1 = Mid(stTarget, 1, InStrRev(stTarget, " ") - 1) '図形名
st_text2 = Mid(stTarget, InStrRev(stTarget, " ")) '半角スペース＋連番
End If
st_text1 = st_text1 & Space(iMax - Len(st_text1)) '固定長にする
st_buf = Filter(v_Eng, st_text1) 'Filterは結果を配列で返す
If UBound(st_buf) <> -1 Then
id = Replace(st_buf(0), st_text1, "") - 1 '添え字を取得
v_Jpn = Array("直線コネクタ", "直線矢印コネクタ", "コネクタ: カギ線", "コネクタ: 曲線", "フリーフォーム: 図形", "正方形/長方形", "四角形: 角を丸くする", "四角形: 1 つの角を切り取る", "四角形: 上の 2 つの角を切り取る", "四角形: 対角を切り取る", _
"四角形: 1 つの角を切り取り 1 つの角を丸める", "四角形: 1 つの角を丸める", "四角形: 上の 2 つの角を丸める", "四角形: 対角を丸める", "テキスト ボックス", "楕円", "二等辺三角形", "直角三角形", "平行四辺形", "台形", _
"ひし形", "五角形", "六角形", "七角形", "八角形", "十角形", "十二角形", "部分円", "弦", "涙形", _
"フレーム", "フレーム (半分)", "L 字", "斜め縞", "十字形", "ブローチ", "円柱", "直方体", "四角形: 角度付き", "円: 塗りつぶしなし", _
"禁止マーク", "アーチ", "四角形: メモ", "スマイル", "ハート", "稲妻", "太陽", "月", "雲", "円弧", _
"大かっこ", "中かっこ", "左大かっこ", "右大かっこ", "左中かっこ", "右中かっこ", "矢印: 右", "矢印: 左", "矢印: 上", "矢印: 下", _
"矢印: 左右", "矢印: 上下", "矢印: 四方向", "矢印: 三方向", "矢印: 折線", "矢印: U ターン", "矢印: 二方向", "矢印: 上向き折線", "矢印: 右カーブ", "矢印: 左カーブ", _
"矢印: 上カーブ", "矢印: 下カーブ", "矢印: ストライプ", "矢印: V 字型", "矢印: 五方向", "矢印: 山形", "吹き出し: 右矢印", "吹き出し: 下矢印", "吹き出し: 左矢印", "吹き出し: 上矢印", _
"吹き出し: 左右矢印", "吹き出し: 四方向矢印", "矢印: 環状", "加算記号", "減算記号", "乗算記号", "除算記号", "次の値と等しい", "等号否定", "フローチャート: 処理", _
"フローチャート: 代替処理", "フローチャート: 判断", "フローチャート: データ", "フローチャート: 定義済み処理", "フローチャート: 内部記憶", "フローチャート: 書類", "フローチャート: 複数書類", "フローチャート: 端子", "フローチャート: 準備", "フローチャート: 手操作入力", _
"フローチャート: 手作業", "フローチャート: 結合子", "フローチャート: 他ページ結合子", "フローチャート: カード", "フローチャート: せん孔テープ", "フローチャート: 和接合", "フローチャート: 論理和", "フローチャート: 照合", "フローチャート: 分類", "フローチャート: 抜出し", _
"フローチャート: 組合せ", "フローチャート: 記憶データ", "フローチャート: 論理積ゲート", "フローチャート: 順次アクセス記憶", "フローチャート: 磁気ディスク", "フローチャート: 直接アクセス記憶", "フローチャート: 表示", "爆発: 8 pt", "爆発: 14 pt", "星: 4 pt", _
"星: 5 pt", "星: 6 pt", "星: 7 pt", "星: 8 pt", "星: 10 pt", "星: 12 pt", "星: 16 pt", "星: 24 pt", "星: 32 pt", "リボン: 上に曲がる", _
"リボン: 下に曲がる", "リボン: カーブして上方向に曲がる", "リボン: カーブして下方向に曲がる", "スクロール: 縦", "スクロール: 横", "波線", "小波", "吹き出し: 四角形", "吹き出し: 角を丸めた四角形", "吹き出し: 円形", _
"思考の吹き出し: 雲形", "吹き出し: 線", "吹き出し: 折線", "吹き出し: 2 つ折線", "吹き出し: 線 (強調線付き)", "吹き出し: 折線 (強調線付き)", "吹き出し: 2 つ折線 (強調線付き)", "吹き出し: 線 (枠なし)", "吹き出し: 折線 (枠なし)", "吹き出し: 2 つ折線 (枠なし)", _
"吹き出し: 線 (枠付き、強調線付き)", "吹き出し: 折線 (枠付き、強調線付き)", "吹き出し: 2 つ折線 (枠付き、強調線付き)", "グループ化")
changeEngToJpn = v_Jpn(id) & st_text2
Else
changeEngToJpn = stTarget
End If
End Function
最後に
VBAで図形名(Shape.Name)を画面表示したり帳票に出力したりすることはあまり無い事かと存じます。
また入力されたデータを変換するような場合はデータベースを使った方が後々のメンテナンスを考えると便利であると思いますが、更新の少ないコードを変換するようなケースであれば関数化する事もあり得るかもしれません…
なお本来であればVBAの図形名が日本語対応される事が望ましいはずですが、「多言語対応されるか?」につきましては例えば日本語キーボードではバックスラッシュが円記号に割り当てられていますが、その事への対応を見ても「VBAで対応されるのか?」という点につきましては微妙のような気がします。
以上最後までご一読いただき誠にありがとうございました。
追伸 2022/1/27
VBAで日本語図形名が機能している事に気が付きました。ただし…言い方が難しいのですが日本語名をVBAで判定するという所です。
左図イミディエイトウィンドウの結果のように日本語変換した図形名でShapeを特定する事ができます。
という事は「VBAで対応されるのか?」の件は早計でした。申し訳ありません。
そうは言っても、そこまでできているのであれば「name」プロパティは英語・修正後用として残しておいて、新たに例えば「nameT」プロパティもしくは「name」の属性指定で多言語に変換した結果を提供していただければ有難いです。
