VBAの画像貼り付けに関して

以下の文でvbaを動かしています。しかし、スマホで撮影した縦向きの写真のみ設定している場所に貼ることができません。webで拾った縦の画像やスマホ撮影の横向きは貼れます。
初心者のためのその原因がわかりませんわかる方がいましたら教えて欲しいです。

　 Dim sheet As Worksheet
Dim filePath As String
Dim targetRange As Range
Dim picture As Shape
Dim targetRangeHeight, targetRangeWidth As Single

' シートを指定する
Set sheet = ActiveSheet

' ファイルを選択
filePath = Application.GetOpenFilename
If filePath <> "False" Then

Else
Exit Sub
End If





' 貼り付ける範囲を指定する
Set targetRange = Range("B4:J28")
targetRangeWidth = targetRange.Width '幅
targetRangeHeight = targetRange.Height '高さ

' 図を挿入する
Set picture = sheet.Shapes.AddPicture( _
filename:=filePath, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=0, _
top:=0, _
Width:=-1, _
Height:=-1)


With picture
.LockAspectRatio = True

' 画像の大きさを設定する
.Left = targetRange.Left
.top = targetRange.top




' 指定範囲よりも画像の縦横両方が小さい場合
If .Width > targetRangeWidth And .Height > targetRangeHeight Then
.Width = targetRangeWidth


If .Height > targetRangeHeight Then
.Height = targetRangeHeight

End If

End If

End With

No.1 回答者： fujillin 回答日時： 2021/04/13 23:00

こんばんは

PowerPointのカテですけれど、PPに貼る場合の処理？？
どう見ても、エクセルっぽいので、以下は、エクセルと仮定しての回答です。


＞縦向きの写真のみ設定している場所に貼ることができません。
「貼ることができない」の意味がわかりませんが、所定の位置には表示されているのではないでしょうか？
それとも、画像が表示できないってことでしょうか？
ざっと見て想像するところ、「画像は貼れるがサイズの調整ができない」ってだけではないのでしょうか？

実際に何が起こっているのかわかりませんけれど、想像があたっているなら、ご提示のコードだと、
「縦横ともにセル範囲より大きい時だけサイズ調整をする」
ような処理になっているのが原因ではないでしょうか？
（片方が小さかったり、両方小さければ調整されない）

普通だと、指定した範囲に収まるように、縦（または横）がピッタリになるようにサイズ調整するとかが多いと思いますが、質問者様がどうなさりたいのかもわかりません。
現状のサイズ調整を必ずできるようにしたいのなら、最初のIF文を削除すればよいと思われます。
（これで、すべての画像に対してサイズ調整するようになります）

具体的には、
　.Width = targetRangeWidth
　　If .Height > targetRangeHeight Then .Height = targetRangeHeight
　End If
とするとか。

表示位置はセル範囲の左上に合わせられていますが、中央合わせにしたい場合には、例えば横方向なら、
　(targetRangeWidth - picture.Width)/2
分だけ微調整すれば良いことになります。（縦方向も同様）


※ 未確認ですので、外していたらスルーしてください。