『画像貼り付けで上書きされてしまう』(VBA初心者) お世話になります。 【エクセルでダブルクリックし、画像フォルダより 画像を選択し、セルの中央に空白部分を作って、実像として貼り付け】 という VBA素人ながらネットで調べまくって 下記のコードを作りました。 Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) Dim myF As Variant Dim mySp As Object Dim myAD1 As String Dim myAD2 As String Dim myHH As Double Dim myWW As Double Dim myHH2 As Double Dim myWW2 As Double Cancel = True '===============?I??Z????? If Intersect(Range("F6:J40"), Target) Is Nothing Then Exit Sub '===============???I?? myF = Application.GetOpenFilename _ ("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "????I??", , False) If myF = False Then MsgBox "????I????????????(?I??)" Exit Sub End If '===============????|?? For Each mySp In ActiveSheet.Shapes myAD1 = mySp.TopLeftCell.MergeArea.Address myAD2 = Target.Address If myAD1 = myAD2 Then mySp.Delete Next '===============????\??t?? Set mySp = ActiveSheet.Shapes.AddPicture(Filename:=myF, LinkToFile:=False, _ SaveWithDocument:=True, Left:=Target.Left, Top:=Target.Top, _ Width:=0, Height:=0) '?c???O??B mySp.ScaleHeight 1, msoTrue '????T?C?Y???? mySp.ScaleWidth 1, msoTrue '????T?C?Y???? mySp.LockAspectRatio = msoTrue '?c????????? '===============?^?e???R??k????? If mySp.Width > Target.Width Then mySp.Width = Target.Width - 10 If mySp.Height > Target.Height Then mySp.Height = Target.Height - 10 '===============????????? myHH2 = (Target.Height / 2) - (mySp.Height / 2) myWW2 = (Target.Width / 2) - (mySp.Width / 2) mySp.Top = Target.Top + myHH2 mySp.Left = Target.Left + myWW2 Set mySp = Nothing End Sub ですが、 張り付けると前からあった画像が上書きされて消えてしまいます。 写真に名称等をテキストで張り付けてあったのですが 写真を入れ替えるのにVBAで張り付けると消えてしまいます。 このコードになにをいれればいいのでしょうか? ご指導宜しくお願い致します。 OSはWINDOWS10です < 使用 Excel:Excel2010、使用 OS:unknown > ---- For Each mySp In ActiveSheet.Shapes myAD1 = mySp.TopLeftCell.MergeArea.Address myAD2 = Target.Address If myAD1 = myAD2 Then mySp.Delete Next ここで削除していますよね。それは理解されているのでしょうか? (γ) 2020/04/11(土) 08:13 ---- γ様 返信ありがとうございます。 すいません自己解決しました。 そこは理解していて コードを消したのですが 消していないシートで試していて 出来ない出来ないと焦っていました。 消したシートでやってみたところ 出来ました。 申し訳ないです。 あと別の質問なのですが 最背面はmsoSendToBackの使用で良いと思うのですが どこにどのようにいれればよろしいのでしょうか? 宜しくお願いします。 (VBA初心者) 2020/04/11(土) 08:27 ---- >最背面はmsoSendToBackの使用で良いと思うのですが 何をしたいのかによります。その説明がないので、わかりません。 (γ) 2020/04/11(土) 08:34 ---- γ様 お世話になります。 説明不足で申し訳ないです。 テキストとかのオブジェクトは同じものですので 画像だけ変更するときに 上記VBAで読み込んで自動で張り付けてあるオブジェクトの背面に貼り付け ということをしたいのですが。 今のですと読み込んだ場合最前面にくるので一つ一つ最背面にという作業をしています。 よろしくお願いします。 (VBA初心者) 2020/04/12(日) 09:10 ---- 挿入した直後に mySp.ZOrder msoSendToBack などとしてみたのでしょうか。不都合が起きますか? 上手くいかなければ、別のところで試してみては? (γ) 2020/04/12(日) 09:30 ---- お世話になります。 myHH2 = (Target.Height / 2) - (mySp.Height / 2) myWW2 = (Target.Width / 2) - (mySp.Width / 2) mySp.Top = Target.Top + myHH2 mySp.Left = Target.Left + myWW2 この下に挿入したら出来ました。 色々ご教授ありがとうございました。 (VBA初心者) 2020/04/12(日) 10:02