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:-

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