When a photo is inserted into Excel in VBA and rotated incorrectly

The other day I got a bit stuck at work creating a VBA tool to batch insert photos into Excel.

The tool inserts photos sequentially into a fixed format when you press the Insert Image button, but when the client tried it, he asked me to take a look because some of the photos were off the cells and other things were wrong.

When I turn the tool around myself, it fits the cell perfectly. There does not seem to be anything wrong. When inserting into a format cell, the size should fit the cell and the position should be centered. The process looks like this. *Since this is a sample, it is a single sheet insertion pattern.

Option Explicit
Public Sub InsertPicture()

    
    Dim mySh As Worksheet
    Dim myRng As Range
    Dim shp As Shape
    Dim picPath As String
    Dim picWidth As Double
    Dim picHeight As Double
    
    
        Application.ScreenUpdating = False
        
        Set mySh = ThisWorkbook.Sheets("test")
        
        picPath = "D:\test\sample.jpg"

        'Delete all existing images
        For Each shp In mySh.Shapes
            shp.Delete
        Next

        Set myRng = mySh.Range("A1")
        
        With myRng
            picWidth = .Width * 0.992
            picHeight = .Height * 0.992
        End With
        
        'Insert image
        Set shp = ActiveSheet.Shapes.AddPicture( _
            Filename:=picPath, _
            LinkToFile:=False, _
            SaveWithDocument:=True, _
            Left:=myRng.Left + 1, _
            Top:=myRng.Top + 1, _
            Width:=0, Height:=0)

        shp.ScaleHeight 1!, msoTrue
        shp.ScaleWidth 1!, msoTrue
        shp.LockAspectRatio = msoTrue
        
        'Adjust the size of the image to the size of the cell
        With shp
            .Height = picHeight
            If .Width > picWidth Then
                .Width = picWidth
            End If
          
            .Left = myRng.Left + (picWidth / 2 - .Width / 2) + 0.9
            .Top = myRng.Top + (picHeight / 2 - .Height / 2) + 0.9
        End With
              
        Set shp = Nothing
        Set myRng = Nothing
        Set mySh = Nothing
        
        Application.ScreenUpdating = True
        

End Sub

When we looked at the Excel file that the client had dropped the photos into using the tool, they were indeed misaligned. The only misalignments were vertical images that were significantly out of alignment.

So we asked the client to send us not only the dropped excel file but also the photo, and we ran the tool on the same photo. It fits the cell size beautifully.

I can’t reproduce it…

When I looked closely at the Excel file that was sent to me after I turned the tool on the client’s side, the one that was out of position was the vertical image, and it was indeed a vertical image of a person.

Huh?

When I look at the photos sent to me, they are all horizontal images. Why are they inserted in portrait?

When I asked the person who placed the order, he said that on his PC, vertical photos are displayed vertically and the photos are mixed vertically and horizontally. There are no vertical images on my PC.

I am on Windows 7 and the client is on Windows 10.

I found out that Windows 7 does not recognize the rotation information in the Exif of the image until Windows 7. Therefore, my PC did not have the vertical rotation information and recognized it as a horizontal image.

The problem of the vertical image being shifted was because Windows 10 also recognized the size of the photo as the opposite of the vertical and horizontal size when inserting a vertical image into Excel using VBA.

In other words, Windows 10 can recognize rotation, and when the image is inserted, the vertical is inserted as portrait. After that, when the image is perfectly aligned with the cell in VBA, the width and height of the image are acquired, but at this time, the rotation is not recognized, and the height is acquired as the width and height of the width, and the width is acquired as the width and height of the height.

Oh dear.

After much trial and error, I was able to get the image to fit perfectly in the format cell on both PCs by inserting the image once, pasting it back in as a JPEG, and then looking at the height and width of the JPEG.

Modified code

Option Explicit
Public Sub InsertPicture()

    
    Dim mySh As Worksheet
    Dim myRng As Range
    Dim shp As Shape
    Dim picPath As String
    Dim picWidth As Double
    Dim picHeight As Double
    
    
        Application.ScreenUpdating = False
        
        Set mySh = ThisWorkbook.Sheets("test")
        
        picPath = "D:\test\sample.jpg"

        'Delete all existing images
        For Each shp In mySh.Shapes
            shp.Delete
        Next

        Set myRng = mySh.Range("A1")
        
        With myRng
            picWidth = .Width * 0.992
            picHeight = .Height * 0.992
        End With
        
        'Insert image
        Set shp = ActiveSheet.Shapes.AddPicture( _
            Filename:=picPath, _
            LinkToFile:=False, _
            SaveWithDocument:=True, _
            Left:=myRng.Left + 1, _
            Top:=myRng.Top + 1, _
            Width:=0, Height:=0)
            
        shp.ScaleHeight 1!, msoTrue
        shp.ScaleWidth 1!, msoTrue
        shp.LockAspectRatio = msoTrue
         
        'Re-paste as a JPEG drawing because Windows does not recognize the rotation.
        shp.Cut
        ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False

        With Selection.ShapeRange
            .Top = myRng.Top + 1
            .Left = myRng.Left + 1

            .Height = picHeight
            If .Width > picWidth Then
                .Width = picWidth
            End If

            .Left = myRng.Left + (picWidth / 2 - .Width / 2) + 0.9
            .Top = myRng.Top + (picHeight / 2 - .Height / 2) + 0.9
        End With
           
        Set shp = Nothing
        Set myRng = Nothing
        Set mySh = Nothing
        
        Application.ScreenUpdating = True
        

End Sub

In lines 45 to 59, the image is pasted again as a JPEG figure because Windows does not recognize the rotation.

However, when pasting as a JPEG image, the resolution of the image will be reduced. The tool I was asked to use this time was small in size, with a thumbnail format of 6 x 4 = 24 images on an A4 size sheet, so the image degradation was not enough to be a concern, but the A4 size However, in the case of three images on one A4 sheet, I think it is better to check if the images are at a viewable level.

I wonder if Windows 7 will support rotational recognition with a Windows update or something.