Excel VBAのことでお聞きしたいことがあり、ご教授お願いします。 下記の3つの図形があり、この

Excel VBAのことでお聞きしたいことがあり、ご教授お願いします。

下記の3つの図形があり、この3つをそのまま一番最後の図形(黄色)の後ろにコピペをしたいのですが、どのようにコードをかいたらよいのでしょうか、、？
又、上記の事を繰り返し行う場合の書き方も教えて欲しいです…

今まで試みたこと↓
○グループ化(マクロで出来なかった) 警告文:選択した図形はグループ化出来ませんでした。　と出ました。

ざっくりで申し訳ございませんが、何かヒントやアドバイスを頂ければ幸いです。よろしくお願いします。

No.3 ベストアンサー 回答者： Qchan1962 回答日時： 2022/08/09 11:10

こんにちは

変数iが出てきて良く分からなくなりました

VBA実行前に3組の図形が沢山あるのでしょうか？　iでループする分

それとも、３つの図形があり、それを重ねてグループにして
任意の回数分　複製し重ねる（又は移動）するのでしょうか？

それとも、沢山ある図形をすべて同じ位置に重ねるのでしょうか？

また、元図形はどうするのでしょうか？　移動する？それともそのまま残す？

レイヤーの順序はどうしますか？

あと、図形の名前を利用するのは良いのですが、コピペの場合
少し面倒かも知れませんね

例として
素材をコピペ、重ねてグループに　グループにした図形をコピペですと

Dim shp1 As Shape, shp2 As Shape, shp3 As Shape
Set shp1 = ActiveSheet.Shapes("四角")
Set shp2 = ActiveSheet.Shapes("a四角")
Set shp3 = ActiveSheet.Shapes("b四角")
shp1.Copy
Range("D5").Select
ActiveSheet.Paste '貼り付け
Set shp1 = Selection.ShapeRange(1)
shp2.Copy
Range("D5").Select
ActiveSheet.Paste '貼り付け
Set shp2 = Selection.ShapeRange(1)
shp3.Copy
Range("D5").Select
ActiveSheet.Paste '貼り付け
Set shp3 = Selection.ShapeRange(1)

'選択してグループ化
shp1.Select Replace:=False
shp2.Select Replace:=False
shp3.Select Replace:=False
Selection.ShapeRange.Group
'この下をループする？
Selection.Copy
Range("D10").Select
ActiveSheet.Paste '貼り付け

Range("A1").Select

素材画像が同じサイズなら　同じセルにコピーするので位置はセル位置となり調整は不要かと・・
1つずつコピペは
For Each sName In Array("四角", "a四角", "b四角")
ActiveSheet.Shapes(sName).Copy
ActiveSheet.Paste Destination:=Range("D5")
こんな書き方も出来ますが、後でグループにする時に少々困ります
また、任意の名前を付けて配列に入れ
Selection.ShapeRange(1).Name =？＆ｎ
ary(n) = Selection.ShapeRange(1).Name

ActiveSheet.Shapes.Range(ary).Select
みたいなやり方も出来るかもしれませんが、確認していません

すべての図形を重ねてグループ、グループをコピペなら
もう少しすっきりかけると思います・・

最終的にどのようにしたいのか・・・
図形を沢山コピペした時に　その後どのように使うのでしょう？
沢山ある場合は、どのような名前を付けるか・・など　課題がありそうですね
タイムアップで失礼します

この回答へのお礼

ご丁寧にありがとうございました。

お礼日時：2022/09/01 23:39

No.2 回答者： Qchan1962 回答日時： 2022/08/08 19:44

こんばんは

まず、シェイプを特定する必要があります
例えば、テーマからでサンプル画像の場合（ForeColor.RGBで色を特定）
12874308などは適時調べて変更

Sub sample()
Dim shp As Shape, 青 As Shape, オレンジ As Shape, 黄 As Shape
For Each shp In ActiveSheet.Shapes
Select Case shp.Fill.ForeColor.RGB
Case 12874308
Set 青 = shp
Case 3243501
Set オレンジ = shp
Case 49407
Set 黄 = shp
End Select
Next
各Shapeに対して・・・コピペ？
黄色は1つで良いの？ループってたくさん重なった図形を作るのでは？
移動かな？

まサンプルで
青をコピーして任意の位置にペースト、黄位置に移動（サイズの言及がないので割愛）

青.Copy
Range("D5").Select
ActiveSheet.Paste '貼り付け
Set 青 = Selection.ShapeRange(1)
青.Left = 黄.Left
青.Top = 黄.Top

オレンジも青同様

オレンジ.Copy
Range("D5").Select
ActiveSheet.Paste '貼り付け
Set オレンジ = Selection.ShapeRange(1)
オレンジ.Left = 黄.Left
オレンジ.Top = 黄.Top

背面に移動
'オレンジを最背面
オレンジ.Select
Selection.ShapeRange.ZOrder msoSendToBack
'青を最背面
青.Select
Selection.ShapeRange.ZOrder msoSendToBack
'結果上から黄色オレンジ青で重なる

この重なった図形をグループ化
各図形オブジェクトを選択してグループ　名前も付けときます

'選択してグループ化
青.Select Replace:=False
オレンジ.Select Replace:=False
黄.Select Replace:=False
' Selection.ShapeRange.Group.Name = "Group1"

図形の選択を解除

Range("A1").Select
End Sub

一応、コード部分で実行可能かと思いますが

＞上記の事を繰り返し行う場合
どの様な条件で繰り返すのでしょう？

どの様に図形を特定するかが問題ですね　2度目は同じ色の図形があるので
ずばり名前で特定した方が良いと思います
グループにした同じ３枚の図形を沢山作るのなら、最初に黄色をコピペ
グループにした後に移動のような手順でしょうか？

この回答へのお礼

詳しくご回答いただきありがとうございます！！
色でやるやり方もあるんですね！勉強になります！
図形に名前をつけてみました！下にも続く予定なので、for i =1 to 図形のカウントをして、"四角"&i 、"a四角"&i、''b四角"&i と3つの図形に名前をつけました！最後の[''b四角"&i]の後に3つの図形を繰り返しおいていきたいです。(これからの計画としましては、A列に繰り返し回数の数字を入力し、その回数分、最後の[''b四角"&i]の後に3つの図形を置くことを繰り返したいです…。わかりにくい説明でごめんなさい。ご教授のほど宜しくお願いします。

お礼日時：2022/08/09 08:45

No.1 回答者： fujillin 回答日時： 2022/08/08 18:39

こんにちは

＞後ろにコピペをしたいのですが、～
「後ろ」というのは前後の後ろの意味で良いのでしょうか？

サイズがわからないけれど、添付図の見た目では橙色の幅の方が黄色より大きそうなので、はみ出てしまいそうな気がしますが・・
メソッド等は「マクロの記録」でも取ってみればわかると思いますが、概ね以下の手順でできるのではないでしょうか？

1）対象の図形をコピペ
2）図形位置を目的の図形（黄色）の位置に合わせる
3）前後位置（ZOrde）を最背面に移動

※ 中心位置合わせにしたい場合は、Left、Topに幅・高さの1/2を加えた位置が同じになるように計算すれば良いでしょう。

この回答へのお礼

ありがとうございます！！マクロの記録でやっても、上手くいきませんでした、、なぜか図形の大きさが変わってしまったり、グループ化して移動しようと考えていたのですが、マクロの記録だと上手く読み込む事が出来ませんでした…

お礼日時：2022/08/09 08:47