画像の位置・サイズ自動調整貼り付け

Question

Excelで結合しているセルに写真のサイズに合わせて自動調節するマクロを組みたいと考えているのですが、結合セルの大きさ（縦横の長さ）をうまく設定できないため、まずは１枚手動で調節して大きさを決めてから、位置をマクロで調節しています。
これらの動作を一度にやる方法はありませんでしょうか。

また、結合セルなので、上下の位置設定もうまくできず、望ましい位置になるまで、数値をずらして調整している状態です。

ご指摘お願いいたします。

Sub 画像挿入()
Dim rng As Range
Set rng = ActiveCell
ActiveSheet.Paste
With Selection
.ShapeRange.LockAspectRatio = False
.Placement = xlMoveAndSize

.Width = 196.255676　'予め取得した数値を記入
.Height = 168.841888　'予め取得した数値を記入



.Left = rng.Left + (rng.Width - .Width) / 2
.Top = rng.Top + (rng.Height) / 2　'セルの大きさにより、分母を修正

End With
End Sub

Answer 1

結合セルにおさめるだけなら下記で大丈夫ですが、
縦横比は固定しなくていいでしょうか？
位置設定はどのようなものを意図しておられますか？

Sub 画像挿入()
Dim rng As Range
Set rng = ActiveCell
ActiveSheet.Paste
With Selection
    .ShapeRange.LockAspectRatio = False
    .Placement = xlMoveAndSize

    .Width = rng.MergeArea.Width
    .Height = rng.MergeArea.Height

End With
End Sub

---

WidthとHeightに0.99をかけて99%にしています。
マイナスにしたり数値はお好みで。

Sub 画像挿入()
Dim rng As Range
Set rng = ActiveCell
ActiveSheet.Paste
With Selection
    
    .ShapeRange.LockAspectRatio = False
    .Placement = xlMoveAndSize

    .Width = rng.MergeArea.Width * 0.99
    .Height = rng.MergeArea.Height * 0.99
    
    .Left = rng.MergeArea.Left + (rng.MergeArea.Width - .Width) / 2
    .Top = rng.MergeArea.Top + (rng.MergeArea.Height - .Height) / 2

End With
End Sub

Comments

[pulim]

回答ありがとうございます。
位置設定につきましては、Activecellの中央に配置するようにしたいと考えています。
また、サイズにつきまして、罫線の内側に入るギリギリのサイズが望ましいのですが、示されているコードに-数字をして調節する方法でよろしいでしょうか。
追記してしまい、申し訳ございませんが、よろしくお願いいたします。

[pulim]

ありがとうございます。非常に助かりました。