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:
Insert a temp sheet
Insert the image into that sheet
Use IncrementRotation
rotation property
Export the image to user's temp directory
Delete the temp sheet
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.
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:UsersPublicPicturesSample PicturesKoala.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:UsersPublicPicturesSample PicturesKoala.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!
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…