Excel VBA グループ解除、再グループ化
エクセルマクロを勉強始めてから、年数が経ちました。はじめは、メールマガジンの教材を購入しました（Wordマクロの書籍は購入していたのですが、Excelマクロの勉強は初めてでした）。教材で勉強して、簡単なマクロは作れるようになったのです。勉強のため、グループ化されたオートシェイプを解除して、再グループ化して元に戻すマクロに挑戦しました。はっきり言って、無謀でした。VBAの基礎を学んだだけで、配列の勉強もしていなかったのです。でも、難しいマクロに挑戦することが、勉強になると思いました。セルを扱うマクロは、サンプルも多くて、情報があふれています。あえて、図形を扱いたかったのですが、異常にむずかしくて･･･。一重グループ化なら、何とかなりそうですが、実用的ではありません。何重にもグループ化された図形にも対応可能なものを作りたかったのですが、私には高難度すぎました。まずは、ネット検索して、方法を調べました。グループ化解除は、サンプルマクロがたくさんありました。再帰という方法で、多重グループ化にも対応でするそうです。再帰が何かすら初めて知りました。グループ解除のコードは、ほぼサンプル丸写ししました。ワンパターンなので、サンプルはみな似ていました。問題は、どうやって再グループ化するかです。ネットでさがしても、サンプルが見つかりません。再グループ化のコードを求めている人はいるのですが、解決法は見当たらなくて。その後、オンライン講座を受講したり、書籍でも勉強しました。新たな勉強をするたび、このマクロに挑戦するのですが、毎回途中で挫折です。どのような手順ですればよいのか、頭の中で組み立てられないと、コードを書くことはできません。パソコンから離れて、頭の中で、グルグル考えました。いくら考えても、これといった解決法も思いつかなくて。この状態で、コードを書いてみても、先へ進みません。今年に入って、2冊のVBA本でさらに勉強しました。。VBAの勉強もかなりしてきましたので、最低限の知識はあるはず。配列も知らなかった頃とは違います。学んだことを工夫すれば、完成できるはずでした。はっきり言って、このマクロは勉強のためで、完成しても使わないと思います。でも、繰り返し挑戦してきたので、なんとしても完成したかったのです。他のもっと簡単なマクロに挑戦しても、未完成なこのマクロが気にかかります。これまでネットで検索しても有益な情報がなかったのですが、ヒントらしきものは見つかりました。図形を階層式にワークシートに書き出して、それを復元するというものです。これをヒントに、ワークシートへ図のIDを書き出しました。図のIDは変わらないと聞きました。これは使えそうだと思いました。グループ化を解除するときに、ワークシートに図のIDを書いていくコードを記述しました。ここまでできて、ようやく完成が可能に思えてきました。あとは、ワークシートをもとに、グループ化していくだけです。といっても、簡単ではありませんでした。迷ったのが、複数にグループ化されている場合です。グループ化解除マクロを実行すると、ワークシートに図のIDが書き出されます。 グループ1131412119118グループ2131412グループ1とグループ2は、同じ図のIDがあります。13、14、12は二重にグループ化されているのです。ワークシートには、グループ化を解除する順に上の行から表示されます。再グループ化するときは、下の行からグループ化を行います。まず、グループ2の図のID13、14、12をまずグループ化します。次は、グループ1の5つの図形をグループ化します。ワークシートの図のIDと一致する図形をさがしていきます。でも、13、14、12の図形は、グループ化されていしまっています。そこで、グループ化された図形の中に、一致するIDの図形がないかさがします。見つかったら、グループ化された図形を選択します。13、14、12は同じグループです。3つとも同じグループ名なので、1回グループ化された図形を選択すればOKです。でも、同じグループ名ならどうするかコードがないと、3回選択することになります（エラーになります）。それに対応するため、配列にIDを入れています。既にIDにグループ化されたIDが入っていたら、何もしません。最初に一致した場合のみ、選択するようにします。もともと、配列には図のIDではなく名前を入れていました。これでグループ化するのは簡単だったのです。でも、後で書きますが、図形によってはエラーになってしまいましたので、図を1つずつ選択する方法に変えたのです。だから、配列はもう不要かと思ったのですが、配列にIDを入れて、グループ化されたIDが入っているかどうかの確認に使いました。連想配列にはオブジェクトを格納できるます。連想配列を使うと、普通の配列と1つずつ図形を選択するコードより、簡単にできるかもしれません。最善の方法をさがす余裕はなく、どんなコードでも良いから、とりあえず完成させたいだけでした。こんな面倒なことしなくても…と思われるような、未熟なコードだと思います。でも、完成するまで考えたことは勉強になりました。このコードをそのまま使わないとしても、部分的に今後も参考になりそうです。今後のためにも、うまくいかなかったこと、考えたことを含めて、一応記録しています。前述のとおり、配列（下のコードのmyAry）には、図のIDではなくIDを入れるようにした理由について書いておきます。はじめは、グループ化するために、配列を使って、図の名前を入れていました。 myAry(cnt) = shp.Nameそうすると、下記のコードで、13、14、12をグループ化できるのです。 shWs.Shapes.Range(myAry).Select Selection.ShapeRange.Groupところが、図形をグループ化して試したところ、上記のコードでエラーが出てしまいました。図の名前が同じものがあると（図形をコピーすると、その方法によっては、図形の名前がおなじになります）、エラーが出るようです。同じ名前がある場合のことを考えて、図のIDを書き出していたのに、これではうまくいかないですよね。結局、配列には図の名前ではなく、図のIDを入れることにしました。 myAry(cnt) = shp.ID図のIDがmyAryに入っていますので、下記のコードは使えません。。myAryには図の名前が必要なのです。 shWs.Shapes.Range(myAry).Select Selection.ShapeRange.Group上記のコードはやめて、別の方法を考えました。ワークシートの図のIDと一致する図形が見つかったら、その都度選択することにしました。グループ2の3つの図形を1つずつ選択して追加していき、グループ化します。配列のmyArmは、グループ化された図がすでに選択されているかの確認に使うことにしました。ワークシードの図のIDと一致する図を見つけるたび、選択することにしたので、上記のコードも変更しました。既に図を選択しているので、Selectionから始めています。 Selection.ShapeRange.Group下記がコードのすべてです。グループ化解除マクロで、すべてのグループ化を解除して、ワークシーとに図のIDを書き出します。再グループ化マクロで、ワークシートのリストをもとに、もとの状態に戻します。図形を描いて試したのですが、グループ化の回数を増やすと、うまくいかなかったり。ようやくエラーが出ないものが完成したのですが、複雑な図形で問題なく動作するかはわかりません。Option Explicit Dim yoko As Long Dim tate As LongSub グループ化解除() yoko = 0 tate = 0 Dim flagWs As Boolean '図のIDシートの有無の判定 Dim shp As Shape Dim ws As Worksheet flagWs = False Dim shWs As Worksheet Set shWs = ActiveSheet If shWs.Shapes.Count = 0 Then MsgBox "図形のあるシートを表示してから実行してください" Exit Sub End If For Each ws In Worksheets If ws.Name = "図のID" Then Worksheets("図のID").Range("A1").CurrentRegion.Delete flagWs = True Exit For End If Next If flagWs = False Then Worksheets.Add ActiveSheet.Name = "図のID" End If shWs.Select For Each shp In ActiveSheet.Shapes Call UnGroup(shp) Next End SubSub UnGroup(sh As Shape) Dim has_grp As Boolean 'グループ化されているかどうか判定する Dim gShp As Shape Dim idWs As Worksheet Set idWs = Worksheets("図のID") If sh.Type = msoGroup Then has_grp = True For Each gShp In sh.GroupItems If yoko = 0 Then idWs.Range("A1").Offset(tate, yoko).Value = "グループ" & tate + 1 yoko = yoko + 1 End If idWs.Range("A1").Offset(tate, yoko).Value = gShp.ID yoko = yoko + 1 Next tate = tate + 1 yoko = 0 Do While has_grp For Each gShp In sh.UnGroup Call UnGroup(gShp) Next has_grp = False Loop End IfEnd SubSub グループ化解除した図形を再グループ化() Dim shp As Shape Dim gyo As Long Dim maxCol As Long Dim ret As Long Dim maxGyo As Long Dim gp() As Variant Dim cnt As Long Dim myAry() As Variant Dim c As Long Dim flg As Boolean Dim gShp As Shape Dim n As Long Dim idWs As Worksheet Set idWs = Worksheets("図のID") If ActiveSheet.Shapes.Count = 0 Then MsgBox "図形のあるシートを表示してから実行してください" Exit Sub End If '★もし図形を選択していたら、選択を解除するコードを入れる maxGyo = idWs.Range("A" & Rows.Count).End(xlUp).Row For gyo = maxGyo To 1 Step -1 maxCol = idWs.Range("A" & gyo).End(xlToRight).Column - 1 cnt = 0 Erase myAry For ret = 1 To maxCol For Each shp In ActiveSheet.Shapes If shp.Type <> msoGroup Then If shp.ID = idWs.Range("A" & gyo).Offset(, ret).Value Then ReDim Preserve myAry(cnt) myAry(cnt) = shp.ID shp.Select Replace:=False cnt = cnt + 1 Exit For End If Else flg = False For Each gShp In shp.GroupItems If gShp.ID = idWs.Range("A" & gyo).Offset(, ret).Value Then '同じグループ化された図形が既に配列に入っていないか確認する If Not Not myAry Then '配列か空かどうかを判定す For n = LBound(myAry) To UBound(myAry) If myAry(n) = shp.ID Then flg = True End If Next End If 'グループ化がまだ配列に入っていないときの時、配列に図形名を入れる。 If flg = False Then ReDim Preserve myAry(cnt) 'この位置？ myAry(cnt) = shp.ID shp.Select Replace:=False cnt = cnt + 1 Exit For End If End If Next End If Next Next Selection.ShapeRange.Group Next Application.DisplayAlerts = False idWs.Delete Application.DisplayAlerts = True End Sub
出産・子育て
ファッション
美容・コスメ
健康・ダイエット
生活・インテリア
料理・食べ物
ドリンク・お酒
ペット
趣味・ゲーム
映画・ＴＶ
音楽
読書・コミック
旅行・海外情報
園芸
スポーツ
アウトドア・釣り
車・バイク
パソコン・家電
そのほか
すべてのジャンル
