Ориентация EXIF изображения Excel VBA
сделал этот макрос, который вставляет изображения из active directory в электронную таблицу excel и масштабирует его, чтобы вписаться в ячейку. Он работает довольно хорошо, за исключением изображений, которые поступают из источника, если их ориентация / вращение определены в данных EXIF. Итак:
- в Проводнике Windows-не поворачивается
- окно просмотра изображений - не проворачивается
- IE - не поворачивается
- Хром - Повернутый
- в Excel - Повернул
Это все из-за некоторые проблемы С камеры, с которой было снято изображение. Кто-то пост похожие проблемы но он был помечен как дубликат, неправильно, и с тех пор был проигнорирован. Я нашел это мрачный пост кто-то связал класс чтения exif, я протестировал его, и он дал мне то же самое Orientation
значение для всех моих изображений.
Проблемы: фото получает повернут правильно (УРА!), но его позиция это 35-80 столбцов справа (Бу!) и / или 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