使用VBA旋转保存的图像 [英] Rotate a saved image with vba
问题描述
我目前在excel中有一个用户窗体,上面显示有图像(保存在临时文件夹"C:\ Temp \ Photos"中)
I currently have a userform in excel with images displayed on it (saved in a temporary folder "C:\Temp\Photos")
我想做的是使用按钮(90、180、270)旋转位于"C:\ Temp \ Photos"中的图像.认为这可能是FileSystemObject,但对它们的了解还不够,还不知道如何执行此操作.
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.
谢谢
根据要求添加了一些代码.根据在组合框中选择的值插入图片.任何更改都将引用pic1-pic5(任何时候仅5张图片).
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
推荐答案
就像我提到的那样,没有内置的方式可以旋转用户窗体中的图片.话虽如此,还有一种替代方法可以实现您想要的.下面我演示了如何将图像旋转90度.
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.
逻辑:
-
插入临时表
Insert a temp sheet
将图像插入该工作表
使用IncrementRotation
旋转属性
将图像导出到用户的临时目录
Export the image to user's temp directory
删除临时表
重新加载图像
准备表单
创建一个用户窗体,并插入一个图像控件和一个命令按钮.您的表单可能如下所示.在属性窗口中将图像控件的PictureSizeMode
设置为fmPictureSizeModeStretch
.
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.
代码:
我写了一个子RotatePic
,您可以通过该子学位.就像我提到的那样,此示例会将其旋转90度,正如我刚刚为90
演示的那样.您可以为其余的度数创建额外的按钮.我也对代码进行了注释,因此您在理解它时应该没有任何问题.如果您这样做,则只需询问:)
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
实际操作
运行用户窗体时,将上传图像,并且单击按钮时,图像将旋转!
When you run the userform, the image is uploaded and when you click on the button, the image is rotated!
这篇关于使用VBA旋转保存的图像的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!