Повернуть изображение

[tae1980]

На диске есть графические файлы, в основном bmp, jpg, tiff. Как средствами VBA повернуть их по/против часовой стрелки?

[Aent]

Вопрос задан не совсем корректно. В какой среде нужно повернуть файлы ?
В Excel ? И изменённое изображение должно быть возвращено на диск или
остаться на листе ?
Если последнее:

Selection.ShapeRange.IncrementRotation -90# ' поворачиваем выделенный шейп на 90 градусов против часовой стрелки

Если нужно сохранить изображение на диске то можно:
1) Забрать шейп в ClipBoard
2) Создать Chart объект
3) Вставить изображение в Chart
4) Сохранить Chart

Set objChart1 = ActiveSheet.ChartObjects.Add(200, 200, 400, 400)
objChart1.Activate
ActiveChart.Paste
ActiveChart.Export Filename:="image.jpg", FilterName:="JPEG"

На самом деле так практически никогда, давно никто не делает.

Начиная с SP1 Windows XP в системе изначально присутствует библиотека
Windows Image Acquisition Automation Layer.
Ссылка на загрузку библиотеки «Windows Image Acquisition Library v2.0» и SDK: Download details: Windows® Image Acquisition Automation Library v2.0 Tool: Image acquisition and manipulation component for VB and scripting

Если поддерживаемых WIA форматов недостаточно - можно воспользоваться бесплатной библиотекой GFL SDK
http://www.xnview.com/en/download_gfl.html

[Aent]

Пример использования WIA:

Option Explicit

Public Sub DEMOWIA()
     Const wiaFormatBMP = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"

     Dim objImageFile as Object
     Dim objImageProcess as Object
     Dim strSourcePath as string
     Dim strTargetPath as string

     ' Исходный графический файл:
     strSourcePath = "C:\MyPicture.jpg"
     ' Графический файл с результатом работы:
     strTargetPath = "C:\MyPicture2.bmp"

     Set objImageFile    =  CreateObject("WIA.ImageFile")
     Set objImageProcess = CreateObject("WIA.ImageProcess")

     If Len(Dir(strSorcePath)) = 0 then
           MsgBox "Отсутствует исходный файл"
           exit sub
     End If

     ' Загружаем файл в компонент:
     objImageFile.LoadFile strSourcePath
  
    ' Обрабатываем…
    With objImageProcess
           ' 
           ' Масштабируем:
           ' 
           .Filters.Add .FilterInfos("Scale").FilterID
    
           With .Filters.Item(1).Properties
                 ' Ширина - 800 пикселей
                 .Item("MaximumWidth")  = 800
                 ' Высота - 600 пикселей
                 .Item("MaximumHeight") = 600
           End With
           ' 
           ' Вращаем:
           ' 
           .Filters.Add .FilterInfos("RotateFlip").FilterID
           ' Отразим зеркально по горизонтали
           .Filters.Item(2).Properties.Item("FlipHorizontal") = True
           ' Отразим зеркально по вертикали
           .Filters.Item(2).Properties.Item("FlipVertical")   = True
           ' Повернём на 270 градусов (по часовой стрелке)
           .Filters.Item(2).Properties.Item("RotationAngle")  = 270
    
           ' 
           ' Обрезаем:
           ' 
          .Filters.Add .FilterInfos("Crop").FilterID
    
           With .Filters(3).Properties
           ' Подрежем сверху-снизу
           .Item("Top")    = objImageFile.Width \ 4
           .Item("Bottom") = objImageFile.Width \ 4
           ' Подрежем справа-слева
           '.Item("Left")   = objImageFile.Height \ 10
           '.Item("Right")  = objImageFile.Height \ 10
            End With
            ' 
            ' Конвертируем:
            '
            .Filters.Add .FilterInfos("Convert").FilterID
            ' В bitmap формат
            .Filters.Item(5).Properties.Item("FormatID").Value = wiaFormatBMP
             ' 
            ' Применяем заданные выше фильтры:
            Set objImageFile = .Apply(objImageFile)
            End With

             'WIA не умеет перезаписывать существующий файл, 
            ' потому предварительно удаляем результирующий файл  
            On error resume next
            kill strTargetPath
      
            ' Сохраняем файл:
            objImageFile.SaveFile sTargetPath

Set objImageProcess = Nothing
Set objImageFile    = Nothing
End Sub

[tae1980]

Сообщение от Aent

Вопрос задан не совсем корректно. В какой среде нужно повернуть файлы ?
В Excel ? И изменённое изображение должно быть возвращено на диск или
остаться на листе ?

Спасибо! Очень полезно, буду разбираться.