4

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
Nimantha
  • 6,405
  • 6
  • 28
  • 69
bmgh1985
  • 779
  • 1
  • 14
  • 38

2 Answers2

10

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

Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
  • Nice answer. Had not considered not being able to do it with FSO. Nice solution though. Would not have thought about doing it as a chart and exporting otherwise. Would be just as easy to pass the filepath to the function too and have it use the same path for NewPic as well (thus overwriting the original image in temp folder, do not need to keep old version after). And yes, should be easy to modify for other angles thanks. – bmgh1985 Jan 09 '14 at 08:03
  • @bmgh1985: Glad to be of help :) – Siddharth Rout Jan 09 '14 at 08:03
  • Quick question, can you use Application.Caller on Userform Command Buttons? Would mean I could use the same code for every button and just have it look at the .text property and get the angle. – bmgh1985 Jan 09 '14 at 08:48
  • 1
    Yes you can use `Application.Caller` for form buttons. Few examples [HERE](http://stackoverflow.com/questions/20613945/get-reference-to-forms-checkbox-in-vba-event-handler) and [HERE](http://stackoverflow.com/questions/20613945/get-reference-to-forms-checkbox-in-vba-event-handler/20614054#20614054) and many more if you do a search in stack overflow :) – Siddharth Rout Jan 09 '14 at 08:59
  • 1
    BTW [HERE](http://stackoverflow.com/questions/10782394/pop-up-the-excel-statusbar/10787496#10787496) is another way to export the image to harddrive. I use the Stephen Bullen's PastePicture code to update my progressbars. – Siddharth Rout Jan 09 '14 at 09:05
  • Am getting an error 1004: Method 'Location' of object '_Chart' failed on the line where it moves the chart to the new sheet EDIT: Never mind, it was trying to put it into another workbook I had open. – bmgh1985 Jan 09 '14 at 09:34
  • let us [continue this discussion in chat](http://chat.stackoverflow.com/rooms/44870/discussion-between-siddharth-rout-and-bmgh1985) – Siddharth Rout Jan 09 '14 at 09:35
  • Should anyone else come across this and have an issue with white borders (I got it in Excel 2007) while using the above method, scale your output image resolution down so that the largest side is less than 1000px. This seems to do the trick. – bmgh1985 Jan 09 '14 at 11:54
  • Just FYI for future readers of this question. Another point to make regarding image size. I was also getting an issue with images less than 300px showing white space as well. What I have now done instead is upscale all images immediately before rotation, rotate them and then scale down so the largest side is 800px. This solves all issues I was having of white space around the image. – bmgh1985 Jan 14 '14 at 16:51
  • after `.Shapes(p.Name).Copy` you can avoid using twice the hard drive by just doing `Image1.Picture = PastePicture` (and no using of chart). Google "modPastePicture.bas" for the code of PastePicture (simple module with API's) – Patrick Lepelletier Mar 26 '16 at 23:44
2

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).

Bernard Saucier
  • 2,240
  • 1
  • 19
  • 28
  • Thanks for the help. Another good answer, although as some images may not need rotating at all, the button approach will be what is required in this instance. – bmgh1985 Jan 09 '14 at 08:05