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

Question

Я в настоящее время UserForm в Excel с изображениями, отображаемыми на нем (сохраняется во временной папке «C: \ Temp \ Фотографии»)

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

Благодаря

EDIT: Добавлен код по запросу. Картинки вставляются в зависимости от значения, выбранного в поле со списком. Любые изменения будут ссылаться на 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. загрузить изображение назад

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

Создать UserForm и вставить элемент управления изображения и кнопки управления. Ваша форма может выглядеть так. Задайте в окне свойств значение 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 

в действии

При запуске UserForm, изображение загружается и при нажатии на кнопку, изображение поворачивается!

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 
   

EDIT: так долго, чтобы получить время, чтобы закончить писать пост (от работы), что я пропустил ответ другого пользователя, который, кажется, чтобы использовать ту же логику. Однако мой подход может быть проще для вас!

EDIT2: rotationDegree должен быть установлен на степень поворота (который необходимо определить перед извлечением изображения).