excel VBAで特定の結合セルから画像だけを切り取り、別の結合セルに貼付したい

Question

実現したいこと

教えてください。
業務で使用するexcelなので詳細、スクリーンショットは載せられないのですが

ある作業の「before」「after」の画像を添付するexcelで
「before」の結合セルが写真なしで、「after」にのみ写真がある場合に
「after」の画像を切り取りし、「before」に画像のみ貼り付け（罫線、セル結合は残す）するコードが書きたいのですがうまくいきません。
beforeはB8:E19、afterはG8:J19がそれぞれ結合してあり、4辺に罫線が引いてあります。

beforeのセルをアクティブにしてマクロの記録を使用して試したところ、
ActiveSheet.Shapes.Range(Array("Image 2")).Select
Selection.Cut
ActiveCell.Select
ActiveSheet.Paste
上記のようなコードが出力されたのですが、"Image 2"はその台紙上で画像がたまたま2枚目であるだけなので私が書きたいコードとは違うので困っています。

教えてください。宜しくお願い致します。

発生している問題・分からないこと

beforeのセルをアクティブにしてマクロの記録を使用して試したところ、
ActiveSheet.Shapes.Range(Array("Image 2")).Select
Selection.Cut
ActiveCell.Select
ActiveSheet.Paste
上記のようなコードが出力されたのですが、"Image 2"はその台紙上で画像がたまたま2枚目であるだけなので私が書きたいコードとは違うので困っています。

教えてください。宜しくお願い致します。

該当のソースコード

特になし

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

PasteSpecial Paste:= xlPasteValues
上記コードを使用するとエラーが出てしまいます。

補足

特になし

Comments

[sk.exe]

> ある作業の「before」「after」の画像を添付するexcelで
> 「before」の結合セルが写真なしで、「after」にのみ写真がある場合に
> 「after」の画像を切り取りし、「before」に画像のみ貼り付け
> （罫線、セル結合は残す）するコードが書きたいのですがうまくいきません。
> beforeはB8:E19、afterはG8:J19がそれぞれ結合してあり、4辺に罫線が引いてあります。

それは G8 セル（を左上とする結合セル）と重なる位置に配置されている画像を
B8 セル（を左上とする結合セル）と同じ位置に移動させる、ということと
何が異なるのでしょうか。

[METEORS]

コメントありがとうございます。
画像を移動するコードを調べてみます。

Answer 1

「after」セルの画像を切り取り、「before」セルに貼り付ける方法を説明します。このコードは、"before"セルがアクティブであることを前提としています。

Sub CutPasteImage()
    Dim ws As Worksheet
    Dim rngBefore As Range, rngAfter As Range
    Dim shp As Shape
    
    ' ワークシートを指定
    Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適宜変更
    
    ' "before"と"after"の範囲を指定
    Set rngBefore = ws.Range("B8:E19")
    Set rngAfter = ws.Range("G8:J19")
    
    ' "after"セル内にある画像を切り取る
    For Each shp In ws.Shapes
        If Not Intersect(shp.TopLeftCell, rngAfter) Is Nothing Then
            shp.Cut
            Exit For ' 1つの画像のみ処理するため、処理が完了したらループを抜ける
        End If
    Next shp
    
    ' "before"セルに画像を貼り付ける
    rngBefore.Select ' "before"セルを選択する
    ws.Paste ' 画像を貼り付ける
    
    ' 切り取った画像の形状を削除
    shp.Delete
End Sub

のVBAコードは、「before」セルがアクティブである前提で実行されるため、"before"セルをクリックしてアクティブにしてから実行してください。また、このコードは、「after」セル内に1つの画像しかないことを前提としています。複数の画像がある場合は、それに応じて修正が必要です。

このコードをVBAエディタに貼り付け、実行することで、「after」セルの画像が切り取られ、「before」セルに貼り付けられます。

Answer 2

下記のようなことでしょうか。

Sub Sample()
    Dim beforeRng As Range, afterRng As Range
    Set beforeRng = Range("B8:E19")
    Set afterRng = Range("G8:J19")
    
    Dim beforeShp As Shape, afterShp As Shape
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If Not Intersect(shp.TopLeftCell, beforeRng) Is Nothing Then
            Set beforeShp = shp
        End If
        If Not Intersect(shp.TopLeftCell, afterRng) Is Nothing Then
            Set afterShp = shp
        End If
    Next
    
    If beforeShp Is Nothing And Not afterShp Is Nothing Then
        With afterShp
            .Top = beforeRng.Top
            .Left = beforeRng.Left
        End With
    End If
End Sub