エクセル マクロ picture

質問

教えてもらいながら以下のような画像貼り付けマクロを組んだのですが，以下の点に引っかかり前進することができません．
教えて頂きたいと思い投稿しました．
躓いている点
　シート内でボタンを利用して貼り付け及び削除をしているのですが，エクセルシート内でコピペするたびに「Selection.Name」と貼り付け先を修正しています．
→これをコピペしても修正をしなくてもよいマクロはないでしょうか？
自作作成マクロ
Sub 写真貼付1_Click()
Dim AA As String, BB As String, CC As String
10 AA = InputBox("参照先を指定して下さい。例:D:\Photo001.jpg", "場所指定", AA)
If (AA = "") Then
AA = Application.GetOpenFilename(Title:="写真ファイルの場所はどこですか？")
GoTo 10
End If
ActiveSheet.Unprotect
Range("m29").Select
ActiveSheet.Pictures.Insert(AA).Select
Selection.Name = "写真1"
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 310
Selection.ShapeRange.Width = 310#
Selection.ShapeRange.IncrementLeft 1
Selection.ShapeRange.IncrementTop 1
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True
End Sub
--------------------------------------------------
Sub 写真削除1_Click()
ActiveSheet.Shapes("写真1").Select
Selection.Delete
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True
End Sub

ところどころ端折ってますが，以上のようなマクロです．
よろしくお願いします．

回答No.1

pauNed · ベストアンサー

こんにちは。
>Selection.Name
は元画像ファイルの名前を使うなどして一意のものを設定する。
>貼り付け先
を選択制にする。（もしくはActivecellに貼り付けるようにする）

Sub sample()
　　Dim p As Variant
　　Dim r As Range

　　p = Application.GetOpenFilename _
　　　　("画像ファイル, *.jpg;*.bmp;*.gif", , "図の選択")
　　If VarType(p) = vbBoolean Then Exit Sub
　　On Error Resume Next
　　Set r = Application.InputBox("貼り付け先？", Type:=8)
　　On Error GoTo 0
　　If r Is Nothing Then Exit Sub
　　Application.ScreenUpdating = False
　　With ActiveSheet.Pictures.Insert(p)
　　　　.Name = "pic_" & Dir(p)
　　　　.Top = r.Top
　　　　.Left = r.Left
　　　　.Width = 310
　　　　.Height = 310
'　　　　r.Value = .Name
　　End With
　　Application.ScreenUpdating = True
End Sub

などでしょうか。削除については、今ひとつ要件不明なので...
（ただ単に図を選択してDeleteでも良いような気もしますが）

お礼

回答ありがとうございます．

作成して頂いたマクロを利用すると，
指定した位置に貼付けることができるため，
とても使いやすく便利です．

このマクロの使用目的を台帳の作成とするため，
添付および削除が必要と考え，削除を組み込んでいます．
作成して頂いたマクロを利用して改良していきたいと思います．

また質問することがあると思います．
今後もよろしくお願いします．

回答No.2

imogasi

エクセルのシートの連続セルに、画像ファイル名を並べて置いて
そのファイル名を逐次読みながら、セルの位置のTOPとLEFT,WIDTH,HRIGHTに合わせて
貼り付けるが、そのとき、セルを横へ決められた列だけ移動させて行けばよいのではないですか。サムネイル式。
セルの大きさは適当な大きさにする。
Sub Macro1()
ActiveSheet.DrawingObjects.Delete
k = 3
j = 3
For i = 1 To 20
k = (Int((i - 1) / 4)) * 2 + 3
j = ((i - 1) Mod 4) * 2 + 2
ActiveSheet.Pictures.Insert(Cells(i, "A")).Select
Selection.Top = Cells(k, j).Top
Selection.Left = Cells(k, j).Left
Selection.Width = Cells(k, j).Width
Selection.Height = Cells(k, j).Height
Next i
End Sub
第３行、第2列から、
□　□　□　□
□　□　□　□
□　□　□　□
□　□　□　□
□　□　□　□
のように写真が並びました。
A列には
C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures\Blue hills.jpg
のようなものを入れてテストしました。
隣の写真との間隔やセルの大きさはVBAで指定できますが、略。
質問の意図を取り違えていたら、無視してください。

お礼

回答ありがとうございます．

利用させて頂くためには，
私なりに改良を加えていかなければと思います．

もし，不明な点が出てくれば今後，
異なった質問をすることがあると思います．
その時はよろしくお願いします．