Rotate image/Picture in excel vba userform image control
Rotate image/picture:- This demo allow you to rotate image on userform image control horizontally, vertically, 90 degree, 180 degree and 270 degree.
Other Demos:-
#, Invalid Picture, in vba userform :- • Invalid Picture error message, in Excel v...
#,Circular Image control in excel VBA UserForm :- • Image control(Circular) in excel VBA UserForm
#, Images/Pictures Locker with excel VBA:- • Images/Pictures Locker with excel VBA User...
#, Lock any Excel Workbook in Excel VBA/Protected workbook/worksheet :- • Lock any Excel Workbook in Excel VBA/Prote...
#, Open any type of File (doc , ppt, exe...) In Excell VBA User form:- • Open any type of File (doc , ppt, exe...)...
#,Auto shutdown, Restart, Logoff, Force Restart windows using VBA:- • Auto shutdown, Restart, Logoff, Force Rest...
Module1
...........................................................................
Dim imgDes_imgSource, del As String
Dim ImgFile As WIA.ImageFile
Dim ImgP As WIA.ImageProcess
Dim Selectedfile As String
Sub rotate90Right()
Set ImgFile = New WIA.ImageFile
Set ImgP = New WIA.ImageProcess
imgDes_imgSource = UserForm1.TextBox1.Text
Selectedfile = imgDes_imgSource
ImgP.Filters.Add ImgP.FilterInfos("RotateFlip").FilterID
ImgP.Filters(1).Properties("RotationAngle") = 90
ImgFile.LoadFile Selectedfile
Set ImgFile = ImgP.Apply(ImgFile)
On Error Resume Next
VBA.Kill imgDes_imgSource
ImgFile.SaveFile imgDes_imgSource
On Error GoTo 0
Set ImgP = Nothing
Set ImgFile = Nothing
UserForm1.Image1.Picture = LoadPicture(imgDes_imgSource)
End Sub
Sub rotate180()
Set ImgFile = New WIA.ImageFile
Set ImgP = New WIA.ImageProcess
imgDes_imgSource = UserForm1.TextBox1.Text
Selectedfile = imgDes_imgSource
'Add Filter
ImgP.Filters.Add ImgP.FilterInfos("RotateFlip").FilterID
ImgP.Filters(1).Properties("RotationAngle") = 180
ImgFile.LoadFile Selectedfile
Set ImgFile = ImgP.Apply(ImgFile)
On Error Resume Next
VBA.Kill imgDes_imgSource
ImgFile.SaveFile imgDes_imgSource
On Error GoTo 0
Set ImgP = Nothing
Set ImgFile = Nothing
UserForm1.Image1.Picture = LoadPicture(imgDes_imgSource)
End Sub
Sub rotate270()
Set ImgFile = New WIA.ImageFile
Set ImgP = New WIA.ImageProcess
imgDes_imgSource = UserForm1.TextBox1.Text
Selectedfile = imgDes_imgSource
ImgP.Filters.Add ImgP.FilterInfos("RotateFlip").FilterID
ImgP.Filters(1).Properties("RotationAngle") = 90
ImgFile.LoadFile Selectedfile
Set ImgFile = ImgP.Apply(ImgFile)
On Error Resume Next
VBA.Kill imgDes_imgSource
ImgFile.SaveFile imgDes_imgSource
On Error GoTo 0
Set ImgP = Nothing
Set ImgFile = Nothing
UserForm1.Image1.Picture = LoadPicture(imgDes_imgSource)
End Sub
Sub rotateHorizontal()
Set ImgFile = New WIA.ImageFile
Set ImgP = New WIA.ImageProcess
imgDes_imgSource = UserForm1.TextBox1.Text
Selectedfile = imgDes_imgSource
ImgP.Filters.Add ImgP.FilterInfos("RotateFlip").FilterID
ImgP.Filters(1).Properties("FlipHorizontal") = True
ImgFile.LoadFile Selectedfile
Set ImgFile = ImgP.Apply(ImgFile)
On Error Resume Next
VBA.Kill imgDes_imgSource
ImgFile.SaveFile imgDes_imgSource
On Error GoTo 0
Set ImgP = Nothing
Set ImgFile = Nothing
UserForm1.Image1.Picture = LoadPicture(imgDes_imgSource)
End Sub
Sub rotateVertical()
Set ImgFile = New WIA.ImageFile
Set ImgP = New WIA.ImageProcess
imgDes_imgSource = UserForm1.TextBox1.Text
Selectedfile = imgDes_imgSource
ImgP.Filters.Add ImgP.FilterInfos("RotateFlip").FilterID
ImgP.Filters(1).Properties("FlipVertical") = True
ImgFile.LoadFile Selectedfile
Set ImgFile = ImgP.Apply(ImgFile)
On Error Resume Next
VBA.Kill imgDes_imgSource
ImgFile.SaveFile imgDes_imgSource
On Error GoTo 0
Set ImgP = Nothing
Set ImgFile = Nothing
UserForm1.Image1.Picture = LoadPicture(imgDes_imgSource)
End Sub
Browse Button
........................................................................................................
Dim strPic As String
With Application.FileDialog(1) ' msoFileDialogOpen
.Filters.Clear
.Filters.Add "Image Files (*.jpg,*.bmp, *.gif,*.jfif)", "*.jpg,*.bmp,*.gif,*.jfif"
If .Show Then
Me.Image1.Picture = Nothing
strPic = .SelectedItems(1)
Me.Image1.Picture = LoadPicture(strPic)
TextBox1.Text = strPic
Else
Beep
End If
End With