Excelのマクロ貼り付けについて

表題に関し、作成したマクロが思ったように動きません。

動作目標は以下の通りです。
①選択したセルに実行
②セル内に記載されるパスを参照
③参照したパスの画像を等倍貼り付け
④セルに合わせて画像をリサイズ
⑤結合したセルの中央に配置
⑥　①～⑤を選択したセルだけ実行　以上

環境はExcel Office365 です。
⑤のセル配置において、結合したセルでうまく動作しません。
結合セルの中央ではなく、結合セルの左上の元セルの範囲において
中央に配置されてしまいます。(枠からはみ出してしまいます)

解決方法等わかりましたらお教えいただけると幸いです。
なお、マクロは以下になります。

　　　　　記

Sub Shapes_AddPicture()

' 変数定義
Dim filePath As String
Dim targetCell As Range
Dim image As Shape
Dim lastImg As Integer

' エラーを無視する（画像ファイル読込み失敗時用）
On Error Resume Next

' 選択したセル範囲を順次処理
For Each targetCell In Selection.Cells

' セルを選択
targetCell.Select

' 値があれば
If targetCell.Value <> "" Then

' 画像ファイル名として取得
filePath = targetCell.Value

' 画像読込み
Set image = targetCell.Worksheet.Shapes.AddPicture( _
Filename:=filePath, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Selection.Left, Top:=Selection.Top, _
Width:=0, Height:=0)

'最後に貼った画像を選択
lastImg = ActiveSheet.Shapes.Count
ActiveSheet.Shapes(lastImg).Select

' サイズを等倍にする
With image
.ScaleWidth 1, msoTrue
.ScaleHeight 1, msoTrue
End With

' 縦横比の固定
Selection.LockAspectRatio = True

' 画像が大きい場合、画像サイズをセル幅に合わせる
If Selection.Width / targetCell.MergeArea.Width > Selection.Height / targetCell.MergeArea.Height Then
Selection.Height = Selection.Height * (targetCell.MergeArea.Width / Selection.Width)
Selection.Width = targetCell.MergeArea.Width
Else
Selection.Width = Selection.Width * (targetCell.MergeArea.Height / Selection.Height)
Selection.Height = targetCell.MergeArea.Height
End If

' 表示位置をセル中央に移動
Selection.Top = targetCell.Top + (targetCell.Height - Selection.Height) / 2
Selection.Left = targetCell.Left + (targetCell.Width - Selection.Width) / 2

End If

Next

End Sub
　　　　　　　　　　　　　　　　　　　以上

質問者からの補足コメント

• 早速のご回答ありがとうございます。
  
  ＞結合セルの左上に当たる単独セルのサイズを基に計算しているために、
  ＞齟齬が生じているのではないでしょうか？
  
  冒頭の変数定義において、
  Dim targetCell As Range　とレンジ指定をしているのですが、
  これでは、不足しているということでしょうか。
  確かにご指摘された箇所で問題が発生しているとは思うのですが。。。

  No.1の回答に寄せられた補足コメントです。 補足日時：2019/04/16 13:07

No.1 ベストアンサー 回答者： fujillin 回答日時： 2019/04/16 12:58

こんにちは

ちゃんとは見ていませんが・・・

＞結合セルの中央ではなく、結合セルの左上の元セルの範囲において
＞中央に配置されてしまいます。(枠からはみ出してしまいます)
サイズを計算するのには、きちんとMergeAreaのサイズを用いていますよね。

これに対して、表示位置を計算する際には、
　＞ (targetCell.Height - Selection.Height) / 2
　＞ (targetCell.Width - Selection.Width) / 2
と、結合セルの左上に当たる単独セルのサイズを基に計算しているために、齟齬が生じているのではないでしょうか？

この回答へのお礼

すみません！解決しました！！
最後の箇所を下記のように修正すると正しく動作しました。
fujillinさんのご指摘のおかげで欠損を見つけることができました。
ありがとうございました。

' 表示位置をセル中央に移動
Selection.Top = targetCell.MergeArea.Top + (targetCell.MergeArea.Height - Selection.Height) / 2
Selection.Left = targetCell.MergeArea.Left + (targetCell.MergeArea.Width - Selection.Width) / 2

お礼日時：2019/04/16 13:19