[[20200720092846]]　『縦写真を挿入しても横に伸びてしまう』（はな）　ページの最後に飛ぶ

『縦写真を挿入しても横に伸びてしまう』（はな）

以下のコードを使用することで、結合されたセル内をダブルクリック→比率維持した画像が挿入できたのですが、
去年の夏頃から表題のように上手く表示ができません。

ちなみにエクセルは横長と縦長のセルの結合が同じシートにあり、
「横長のセル」には横写真がきれいに入ります。

不思議な現象なのですが、
「横長のセル」に「縦向きの写真」を挿入すると写真はなぜか縦向きに表示されます。

また、写真の大きさなのですが、平均して1,100KBと大きめなものを扱っており、
試しにiphoneで撮影した縦写真(248KB)を挿入すると縦長のセルにきれいに貼り付けられました。
（形式はどちらもjpgになります）

今回マクロを触るのが初めてで、説明が下手で申し訳ありません。
何方かご教授くださいますと幸いです。
どうぞよろしくお願いいたします。

「MicrosoftⓇExcelⓇ2019MSO(16.0.13001.20266)32ビット」の「Excelバージョン2006」を使用しております。

Option Explicit

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
    Dim myF As Variant
    Dim mySp As Object
    Dim myAD1 As String
    Dim myAD2 As String
    Dim myHH As Double
    Dim myWW As Double
    Dim myHH2 As Double
    Dim myWW2 As Double
    Cancel = True
    '===============画像選択
    myF = Application.GetOpenFilename _
           ("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False)
    If myF = False Then
        MsgBox "画像を選択せずに終了します。", vbOKOnly, "選択の終了"
        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
    If mySp.Height > Target.Height Then mySp.Height = Target.Height
    '===============中央へ調整
    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

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

https://dot-sharp.com/vba-excel-jpeg-rotate/

これ　かな？
（サンダー） 2020/07/20(月) 10:56

サンダー様

ご返信ありがとうございます。
Windows１０になってから不具合が起きているのですね。
教えていただき、ありがとうございます。

まだまだ勉強不足ですので試行錯誤しながら頑張ってみます。
（はな） 2020/07/20(月) 13:50

コメント返信：

[ 一覧(最新更新順) ]

[[20200720092846]] 『縦写真を挿入しても横に伸びてしまう』（はな） ページの最後に飛ぶ

[[20200720092846]]　『縦写真を挿入しても横に伸びてしまう』（はな）　ページの最後に飛ぶ