【急】Excelで写真張り付けマクロを書き換えたい

質問

下記マクロを拾い利用しようと思っているのですが、
以下の点を急ぎ修正しないと使えません。
修正方法などが分からないので、ご教示ください。

要件：
・セルをクリックして写真選択して張り付け、
・縦横比を変えずに、クリックした結合セルサイズ内に収める。
・写真は縦横混在に対応
・写真をセンターに配置する。
・セルのサイズは変動する。

現状の問題点：
・縦向きの写真を挿入した際にセルの上下から画像がはみ出してしまう。

以下コードーーーーーーーーーーーーーーー

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)

Cancel = True

'画像選択コマンド
myF = Application.GetOpenFilename _
("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False)
If myF = False Then
MsgBox "編集する場合はF2を押下してください。"
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
'リサイズして画像の貼り付け
Set mySp = ActiveSheet.Shapes.AddPicture(Filename:=myF, LinkToFile:=False, _
SaveWithDocument:=True, Left:=Target.Left, Top:=Target.Top, _
Width:=0, Height:=0)
mySp.ScaleHeight 1, msoTrue
mySp.ScaleWidth 1, msoTrue
'縮尺を変えずにリサイズ
If mySp.Width > Target.Width Then mySp.Width = Target.Width * 0.99
If mySp.Height > Target.Height Then mySp.Height = Target.Height * 0.99
'センター中心に配置
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

以上ご協力の程宜しくお願い申し上げます。

回答No.1

watabe007 · ベストアンサー

参考に
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Cancel = True
'画像選択コマンド
myF = Application.GetOpenFilename("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False)
If myF = False Then
MsgBox "編集する場合はF2を押下してください。"
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
'リサイズして画像の貼り付け
Set mySp = ActiveSheet.Shapes.AddPicture(Filename:=myF, _
LinkToFile:=False, SaveWithDocument:=True, Left:=Target.Left, _
Top:=Target.Top, Width:=0, Height:=0)
mySp.ScaleHeight 1, msoTrue
mySp.ScaleWidth 1, msoTrue

'縮尺を変えずにリサイズ
mySp.LockAspectRatio = msoTrue ' 縦横比の固定
If (mySp.Width / Target.Width) >= (mySp.Height / Target.Height) Then
mySp.Width = Target.Width
mySp.Top = (Target.Height - mySp.Height) / 2 + Target.Top
Else
mySp.Height = Target.Height
mySp.Left = (Target.Width - mySp.Width) / 2 + Target.Left
End If
Set mySp = Nothing
End Sub

お礼

すごく理解しやすい回答でした✨
お陰でスムーズに対応が完了しましたので本当に感謝しています!