PR
Keyword Search
▼キーワード検索
Calendar
tanpopo3416
わたしのブログへようこそ
Comments
Freepage List
Jul 20, 2020
カテゴリ： Excel VBA
エクセルマクロを勉強始めてから、年数が経ちました。
教材で勉強して、簡単なマクロは作れるようになったのです。
勉強のため、グループ化されたオートシェイプを解除して、再グループ化して元に戻すマクロに挑戦しました。
はっきり言って、無謀でした。VBAの基礎を学んだだけで、配列の勉強もしていなかったのです。
でも、難しいマクロに挑戦することが、勉強になると思いました。
セルを扱うマクロは、サンプルも多くて、情報があふれています。
あえて、図形を扱いたかったのですが、異常にむずかしくて･･･。
一重グループ化なら、何とかなりそうですが、実用的ではありません。
まずは、ネット検索して、方法を調べました。
グループ化解除は、サンプルマクロがたくさんありました。
再帰という方法で、多重グループ化にも対応でするそうです。再帰が何かすら初めて知りました。
グループ解除のコードは、ほぼサンプル丸写ししました。
ワンパターンなので、サンプルはみな似ていました。
問題は、どうやって再グループ化するかです。
ネットでさがしても、サンプルが見つかりません。
再グループ化のコードを求めている人はいるのですが、解決法は見当たらなくて。
その後、オンライン講座を受講したり、書籍でも勉強しました。
新たな勉強をするたび、このマクロに挑戦するのですが、毎回途中で挫折です。
どのような手順ですればよいのか、頭の中で組み立てられないと、コードを書くことはできません。
今年に入って、2冊のVBA本でさらに勉強しました。。
VBAの勉強もかなりしてきましたので、最低限の知識はあるはず。
配列も知らなかった頃とは違います。
学んだことを工夫すれば、完成できるはずでした。
はっきり言って、このマクロは勉強のためで、完成しても使わないと思います。
他のもっと簡単なマクロに挑戦しても、未完成なこのマクロが気にかかります。
これまでネットで検索しても有益な情報がなかったのですが、ヒントらしきものは見つかりました。
図形を階層式にワークシートに書き出して、それを復元するというものです。
これをヒントに、ワークシートへ図のIDを書き出しました。
図のIDは変わらないと聞きました。これは使えそうだと思いました。
グループ化を解除するときに、ワークシートに図のIDを書いていくコードを記述しました。
ここまでできて、ようやく完成が可能に思えてきました。
あとは、ワークシートをもとに、グループ化していくだけです。
といっても、簡単ではありませんでした。
迷ったのが、複数にグループ化されている場合です。
グループ化解除マクロを実行すると、ワークシートに図のIDが書き出されます。
グループ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をグループ化できるのです。
ところが、図形をグループ化して試したところ、上記のコードでエラーが出てしまいました。
図の名前が同じものがあると（図形をコピーすると、その方法によっては、図形の名前がおなじになります）、エラーが出るようです。
同じ名前がある場合のことを考えて、図のIDを書き出していたのに、これではうまくいかないですよね。
結局、配列には図の名前ではなく、図のIDを入れることにしました。
myAry(cnt) = shp.ID
図のIDがmyAryに入っていますので、下記のコードは使えません。。
myAryには図の名前が必要なのです。
上記のコードはやめて、別の方法を考えました。
ワークシートの図のIDと一致する図形が見つかったら、その都度選択することにしました。
グループ2の3つの図形を1つずつ選択して追加していき、グループ化します。
配列のmyArmは、グループ化された図がすでに選択されているかの確認に使うことにしました。
Selection.ShapeRange.Group
グループ化解除マクロで、すべてのグループ化を解除して、ワークシーとに図のIDを書き出します。
再グループ化マクロで、ワークシートのリストをもとに、もとの状態に戻します。
図形を描いて試したのですが、グループ化の回数を増やすと、うまくいかなかったり。
ようやくエラーが出ないものが完成したのですが、複雑な図形で問題なく動作するかはわかりません。
教材で勉強して、簡単なマクロは作れるようになったのです。
勉強のため、グループ化されたオートシェイプを解除して、再グループ化して元に戻すマクロに挑戦しました。
はっきり言って、無謀でした。VBAの基礎を学んだだけで、配列の勉強もしていなかったのです。
でも、難しいマクロに挑戦することが、勉強になると思いました。
セルを扱うマクロは、サンプルも多くて、情報があふれています。
あえて、図形を扱いたかったのですが、異常にむずかしくて･･･。
一重グループ化なら、何とかなりそうですが、実用的ではありません。
まずは、ネット検索して、方法を調べました。
グループ化解除は、サンプルマクロがたくさんありました。
再帰という方法で、多重グループ化にも対応でするそうです。再帰が何かすら初めて知りました。
グループ解除のコードは、ほぼサンプル丸写ししました。
ワンパターンなので、サンプルはみな似ていました。
問題は、どうやって再グループ化するかです。
ネットでさがしても、サンプルが見つかりません。
再グループ化のコードを求めている人はいるのですが、解決法は見当たらなくて。
その後、オンライン講座を受講したり、書籍でも勉強しました。
新たな勉強をするたび、このマクロに挑戦するのですが、毎回途中で挫折です。
どのような手順ですればよいのか、頭の中で組み立てられないと、コードを書くことはできません。
今年に入って、2冊のVBA本でさらに勉強しました。。
VBAの勉強もかなりしてきましたので、最低限の知識はあるはず。
配列も知らなかった頃とは違います。
学んだことを工夫すれば、完成できるはずでした。
はっきり言って、このマクロは勉強のためで、完成しても使わないと思います。
他のもっと簡単なマクロに挑戦しても、未完成なこのマクロが気にかかります。
これまでネットで検索しても有益な情報がなかったのですが、ヒントらしきものは見つかりました。
図形を階層式にワークシートに書き出して、それを復元するというものです。
これをヒントに、ワークシートへ図のIDを書き出しました。
図のIDは変わらないと聞きました。これは使えそうだと思いました。
グループ化を解除するときに、ワークシートに図のIDを書いていくコードを記述しました。
ここまでできて、ようやく完成が可能に思えてきました。
あとは、ワークシートをもとに、グループ化していくだけです。
といっても、簡単ではありませんでした。
迷ったのが、複数にグループ化されている場合です。
グループ化解除マクロを実行すると、ワークシートに図のIDが書き出されます。
| グループ1 | 13 | 14 | 12 | 119 | 118 |
| グループ2 | 13 | 14 | 12 | * | * |
|---|
グループ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
ところが、図形をグループ化して試したところ、上記のコードでエラーが出てしまいました。
同じ名前がある場合のことを考えて、図の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 Long
Sub グループ化解除()
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 Sub
Sub 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 If
End Sub
Sub グループ化解除した図形を再グループ化()
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
お気に入りの記事を「いいね！」で応援しよう
[Excel VBA] カテゴリの最新記事
-
【Excel VBA】ページ毎に別ファイルで保存… Nov 3, 2021
-
グラフのフォントを変更する Excel VBA マ… Sep 24, 2020
【毎日開催】
15記事にいいね！で1ポイント
© Rakuten Group, Inc.
