bmgh1985
bmgh1985

Reputation: 789

How do I rotate a saved image with VBA?

I currently have a userform in excel with images displayed on it (saved in a temporary folder "C:\Temp\Photos")

What I want to do is have buttons (90, 180, 270) for rotating the images located in "C:\Temp\Photos". Thinking it may be an FileSystemObject but dont know enough about them yet to know how to do this.

EDIT: Added some code by request. Pictures are inserted depending on value selected in combobox. Any changes would reference pic1-pic5 (only ever 5 pics at any time).

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

Upvotes: 4

Views: 15798

Answers (2)

Bernard Saucier
Bernard Saucier

Reputation: 2260

The only way I see of doing this would be to copy the picture into a chart, rotate it, export it, and re-open it inside the form the same way you are displaying pictures right now.

Try this.

  1. Change

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

    To

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

    (And everywhere else this structure is used)

  2. Insert, inside a module, the following function :

    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 : Took so long to get the time to finish writing the post (from work) that I missed the other user's answer, which seems to use the same logic. However, my approach might be easier to use for you!

EDIT2 : rotationDegree needs to be set to the degree of the rotation (which needs to be determined before retrieving the picture).

Upvotes: 2

Siddharth Rout
Siddharth Rout

Reputation: 149315

Like I mentioned, there is no inbuilt way to rotate a picture in userform. Having said that, there is an alternative to achieve what you want. Below I have demonstrated on how to rotate the image 90 degrees.

Logic:

  1. Insert a temp sheet

  2. Insert the image into that sheet

  3. Use IncrementRotation rotation property

  4. Export the image to user's temp directory

  5. Delete the temp sheet

  6. Load the image back

Preparing your form

Create a userform and insert an image control and a command button. Your form might look like this. Set the Image Control's PictureSizeMode to fmPictureSizeModeStretch in the properties window.

enter image description here

Code:

I have written a sub RotatePic to which you can pass the degree. Like I mentioned that This example will rotate it 90 degrees as I am just demonstrating for 90. You can create extra buttons for rest of the degrees. I have also commented the code so you shouldn't have any problem understanding it. If you do then simply ask :)

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

In Action

When you run the userform, the image is uploaded and when you click on the button, the image is rotated!

enter image description here

Upvotes: 10

Related Questions