「ブロック機能」のリニューアルについて

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

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

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

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

「Excel VBAのことでお聞きしたいこ」の質問画像
教えて!goo グレード

A 回答 (3件)

こんにちは


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

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

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

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

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

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

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

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

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 =?&n
ary(n) = Selection.ShapeRange(1).Name

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

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

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

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

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

こんばんは


まず、シェイプを特定する必要があります
例えば、テーマからでサンプル画像の場合(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度目は同じ色の図形があるので
ずばり名前で特定した方が良いと思います
グループにした同じ3枚の図形を沢山作るのなら、最初に黄色をコピペ
グループにした後に移動のような手順でしょうか?
    • good
    • 0
この回答へのお礼

やってみます

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

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

こんにちは



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

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

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

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

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

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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング