エクセルマクロ 全シートに図の挿入をしたい

質問

初心者です。よろしくお願いします。
エクセル2007　bookはxsl（互換表示で開いています）
２００シートくらいある請求書です。全シートの同じ場所に角印を押したいです。

自分で考えたコードは１シート目の名前を"FACE"に変え印（"Picture 4"）を貼りつけておきます。
これだとSheets("FACE")に２個目の印が押されてしまいます。

印押しBook.xslのシート１に請求書の雛形と印を用意しておいて
マクロを動かすと請求書Book.xslの全シートに印が押されるものが作れますか？

Sub 印押しマクロ2()
Dim myTop As Single, myLeft As Single
myTop = Sheets("FACE").Shapes("Picture 4").Top
myLeft = Sheets("FACE").Shapes("Picture 4").Left
Sheets("FACE").Shapes("Picture 4").Copy

Dim Sht As Worksheet
For Each Sht In Worksheets
Sht.Select
　　　　ActiveSheet.Paste
　　　　ActiveSheet.Shapes("Picture 4").Top = myTop
　　　　ActiveSheet.Shapes("Picture 4").Left = myLeft
Next Sht
End Sub

回答No.2

keithin · ベストアンサー

各シートで「Picture 4」の有無を手がかりにします。

sub macro1()
　dim myTop as single, myLeft as single
　dim w as worksheet
　mytop = worksheets("FACE").shapes("Picture 4").top
　myleft = worksheets("FACE").shapes("Picture 4").left
　worksheets("FACE").shapes("Picture 4").copy

　on error goto errhandle
　for each w in worksheets
　　w.shapes("Picture 4").top = mytop
　　w.shapes("Picture 4").left = myleft
　next
　exit sub

errhandle:
’Picture 4の無いシートにPicture 4を貼り付ける
　w.paste
　resume
end sub

コツが掴めたら，印画像を「Picture 4」よりもっと分かりやすい名前にしておくと良いかもしれませんね。

お礼

希望通りにの結果が得られました。ありがとうございました。
時間が無く、コードを読み解く事ができませんが
＞印画像を「Picture 4」よりもっと分かりやすい名前にしておく
その通りですね。

回答No.1

real beatin（@realbeatin）

こんにちは。

オブジェクトや条件分岐の扱い方を主題に
基本的な書き方でお応えします。

Sub ReW9134729()
Dim myTop As Single, myLeft As Single
　　With Sheets("FACE").Shapes("Picture 4")
　　　　myTop = .Top
　　　　myLeft = .Left
　　　　.Copy
　　End With

Dim Sht As Worksheet
　　For Each Sht In Worksheets
　　　　With Sht
　　　　　　If UCase(.Name) <> "FACE" Then
　　　　　　　　.Paste
　　　　　　　　With .Shapes(.Shapes.Count)
　　　　　　　　　　.Top = myTop
　　　　　　　　　　.Left = myLeft
　　　　　　　　End With
　　　　　　End If
　　　　End With
　　Next
End Sub

お礼

If UCase(.Name) <> "FACE" Thenでなるほど！と思いました。
同じ結果を得るのに色々な方法があって奥が深いですね。
ありがとうございました。