Поворот сохраненного изображения с помощью VBA

Question

В настоящее время у меня есть пользовательская форма в Excel с изображениями, отображаемыми на нем (сохраненные во временной папке "C:\Temp\Photos")

Что я хочу сделать, так это иметь кнопки (90, 180, 270) для поворота изображений, расположенные в папке "C:\Temp\Photos". Думая, что это может быть FileSystemObject, но пока не знаю достаточно о них, чтобы знать, как это сделать.

Спасибо

РЕДАКТИРОВАТЬ: Добавлен код по запросу. Изображения вставляются в зависимости от значения, выбранного в выпадающем списке. Любые изменения будут ссылаться на pic1-pic5 (только 5 фото в любое время).

Private Sub ComboBox1_Change()
pic1 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\1.jpg"
pic2 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\2.jpg"
pic3 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\3.jpg"
pic4 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\4.jpg"
pic5 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\5.jpg"
If Dir(pic1) <> vbNullString Then
Me.Image1.Picture = LoadPicture(pic1)
Else
Me.Image1.Picture = LoadPicture("")
End If
If Dir(pic2) <> vbNullString Then
Me.Image2.Picture = LoadPicture(pic2)
Else
Me.Image2.Picture = LoadPicture("")
End If
If Dir(pic3) <> vbNullString Then
Me.Image3.Picture = LoadPicture(pic3)
Else
Me.Image3.Picture = LoadPicture("")
End If
If Dir(pic4) <> vbNullString Then
Me.Image4.Picture = LoadPicture(pic4)
Else
Me.Image4.Picture = LoadPicture("")
End If
If Dir(pic5) <> vbNullString Then
Me.Image5.Picture = LoadPicture(pic5)
Else
Me.Image5.Picture = LoadPicture("")
End If
End Sub

Answer 1

Как я уже упоминал, нет встроенного способа поворота изображения в пользовательской форме. Сказав это, есть альтернатива для достижения того, что вы хотите. Ниже я продемонстрировал, как повернуть изображение на 90 градусов.

Логика:

1. Вставьте временный лист

2. Вставьте изображение в этот лист

3. использование IncrementRotation свойство вращения

4. Экспортируйте изображение во временную директорию пользователя

5. Удалить временный лист

6. Загрузите изображение обратно

Подготовка вашей формы

Создайте пользовательскую форму и вставьте элемент управления изображением и командную кнопку. Ваша форма может выглядеть следующим образом. Установите контроль изображения PictureSizeMode в fmPictureSizeModeStretch в окне свойств.

Код:

Я написал саб RotatePic в котором вы можете пройти степень. Как я уже говорил, этот пример повернет его на 90 градусов, как я только что продемонстрировал для 90, Вы можете создать дополнительные кнопки для остальных степеней. Я также прокомментировал код, чтобы у вас не было проблем с его пониманием. Если да, то просто спросите:)

Option Explicit

'~~> API to get the user's temp folder path
'~~> We will use this to store the rotated image
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const MAX_PATH As Long = 260

Dim NewPath As String

'~~> Load the image on userform startup
Private Sub UserForm_Initialize()
    Image1.Picture = LoadPicture("C:\Users\Public\Pictures\Sample Pictures\Koala.jpg")
End Sub

'~~> Rotating the image 90 degs
Private Sub CommandButton1_Click()
    RotatePic 90

    DoEvents

    Image1.Picture = LoadPicture(NewPath)
End Sub

'~~> Rotating the image
Sub RotatePic(deg As Long)
    Dim ws As Worksheet
    Dim p As Object
    Dim chrt As Chart

    '~~> Adding a temp sheet
    Set ws = ThisWorkbook.Sheets.Add

    '~~> Insert the picture in the newly created worksheet
    Set p = ws.Pictures.Insert("C:\Users\Public\Pictures\Sample Pictures\Koala.jpg")

    '~~> Rotate the pic
    p.ShapeRange.IncrementRotation deg

    '~~> Add a chart. This is required so that we can paste the picture in it
    '~~> and export it as jpg
    Set chrt = Charts.Add()

    With ws
        '~~> Move the chart to the newly created sheet
        chrt.Location Where:=xlLocationAsObject, Name:=ws.Name

        '~~> Resize the chart to match shapes picture. Notice that we are
        '~~> setting chart's width as the pictures `height` becuse even when
        '~~> the image is rotated, the Height and Width do not swap.
        With .Shapes(2)
            .Width = p.Height
            .Height = p.Width
        End With

        .Shapes(p.Name).Copy

        With ActiveChart
            .ChartArea.Select
            .Paste
        End With

        '~~> Temp path where we will save the pic
        NewPath = TempPath & "NewFile.Jpg"

        '~~> Export the image
        .ChartObjects(1).Chart.Export Filename:=NewPath, FilterName:="jpg"
    End With

    '~~> Delete the temp sheet
    Application.DisplayAlerts = False
    ws.Delete
    Application.DisplayAlerts = True
End Sub

'~~> Get the user's temp path
Function TempPath() As String
    TempPath = String$(MAX_PATH, Chr$(0))
    GetTempPath MAX_PATH, TempPath
    TempPath = Replace(TempPath, Chr$(0), "")
End Function

В бою

Когда вы запускаете пользовательскую форму, изображение загружается, а когда вы нажимаете на кнопку, изображение поворачивается!

Answer 2

Единственный способ сделать это - скопировать изображение в диаграмму, повернуть его, экспортировать и снова открыть внутри формы так же, как вы сейчас отображаете изображения.

Попробуй это.

1. + Изменить

   If Dir(pic1) <> vbNullString Then
   Me.Image1.Picture = LoadPicture(pic1)
   Else ...
   

   к

   If Dir(pic1) <> vbNullString Then 
   pic1 = myFunction(pic1, rotationDegree)
   Me.Image1.Picture = LoadPicture(pic1)
   Else ...
   

   (И везде эта структура используется)

2. Вставьте внутри модуля следующую функцию:

   Public Function myFunction(myPicture As String, myRotation As Integer) As String
   
   ActiveSheet.Pictures.Insert(myPicture).Select
   Selection.ShapeRange.IncrementRotation myRotation
   Selection.CopyPicture
   
   tempPictureName = "C:\testPic.jpg" 
                     'Change for the directory/filename you want to use
   
   Set myChart = Charts.Add
   
   myChart.Paste
   myChart.Export Filename:=tempPictureName, Filtername:="JPG"
   
   Application.DisplayAlerts = False
   myChart.Delete
   Selection.Delete
   Application.DisplayAlerts = True
   
   myFunction = myDestination
   
   End Function
   

РЕДАКТИРОВАТЬ: потребовалось так много времени, чтобы получить время, чтобы закончить писать сообщение (с работы), что я пропустил ответ другого пользователя, который, кажется, использует ту же логику. Тем не менее, мой подход может быть проще для вас!

РЕДАКТИРОВАТЬ 2: нужно задать значение угла поворота в градусах поворота (которые необходимо определить перед извлечением изображения).