Excel VBA Image EXIF Ориентация

Сделал этот макрос, который вставляет изображения из активного каталога в таблицу Excel и масштабирует его, чтобы соответствовать ячейке. Он работает очень хорошо, за исключением изображений, поступающих из источника, их ориентация/поворот определяется в данных EXIF. Итак, в:

  • В проводнике Windows - не вращается
  • Окно просмотра изображений - не вращается
  • IE - не вращается
  • Chrome - вращение
  • EXCEL - повернут

Все это из-за некоторой унаследованной проблемы от камеры, из которой был сделан образ. Кто-то поставил аналогичную проблему, но неправильно назвал ее дубликатом, и с тех пор ее игнорировали. Я обнаружил, что этот неясный пост был кем-то связанным с классом читателей exif, я его протестировал, и он дал мне то же значение Orientation для всех моих изображений.

Проблемы: фото правильно вращается (YAY!), Но его положение составляет 35-80 столбцов вправо (Boo!) И/или 200 строк вниз, а масштабирование отключено, поскольку оно смешивает поля ширины и высоты (Boo ! x2).

Здесь мой код:

For Each oCell In oRange
        If Dir(sLocT & oCell.Text) <> "" And oCell.Value <> "" Then
        'Width and Height set to -1 to preserve original dimensions.
            Set oPicture = oSheet.Shapes.AddPicture(Filename:=sLocT & oCell, LinktoFile:=msoFalse, savewithdocument:=msoTrue, Left:=oCell.Left + 10, Top:=oCell.Top + 10, Width:=-1, Height:=-1)

            oPicture.LockAspectRatio = True

        'Scales it down  
            oPicture.Height = 200
        'Adds a nice margin in the cell, useless             
            oCell.RowHeight = oPicture.Height + 20
            oCell.ColumnWidth = oPicture.Width / 4
        Else

            oCell.Offset(0, 1).Value = ""
        End If
        Next oCell

Размеры изображения могут быть переменными из неизвестных источников (но я уверен, что мы можем обвинить Samsung в этом). Ищете решение и/или объяснение без необходимости стороннего приложения.

Здесь образец изображений, которые нужно попробовать, первое изображение работает правильно, другие - нет.

ОТВЕТЫ

Ответ 1

Вы должны проверить вращение, чтобы увидеть, нужно ли регулировать высоту или ширину (сверху или влево)

Отрегулируйте петлю следующим образом:

For Each oCell In oRange
        If Dir(sloct & oCell.Text) <> "" And oCell.Value <> "" Then
          Set oPicture = osheet.Shapes.AddPicture(Filename:=sloct & oCell, LinktoFile:=msoFalse, savewithdocument:=msoTrue, Left:=oCell.Left + 10, Top:=oCell.Top + 10, Width:=-1, Height:=-1)

          With oPicture
                .LockAspectRatio = True
            If .Rotation = 0 Or .Rotation = 180 Then
                .Height = 200
                 oCell.RowHeight = .Height + 20
                 oCell.ColumnWidth = .Width / 4
                .Top = oCell.Top
                .Left = oCell.Left
            Else
                .Width = 200
                oCell.RowHeight = .Width + 20
                oCell.ColumnWidth = .Height / 4
                .Top = oCell.Top + ((.Width - .Height) / 2)
                .Left = oCell.Left - ((.Width - .Height) / 2)
            End If

           End With
        Else
            oCell.Offset(0, 1).Value = ""
        End If
        Next oCell