使用 vba 旋转保存的图像

Rotate a saved image with vba

提问by bmgh1985

I currently have a userform in excel with images displayed on it (saved in a temporary folder "C:\Temp\Photos")

我目前在 excel 中有一个用户窗体，上面显示了图像（保存在临时文件夹“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.

我想要做的是有按钮（90、180、270）用于旋转位于“C:\Temp\Photos”中的图像。认为它可能是一个 FileSystemObject，但对它们的了解还不够，还不知道如何做到这一点。

Thanks

谢谢

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

编辑：按要求添加了一些代码。根据在组合框中选择的值插入图片。任何更改都将引用 pic1-pic5（任何时候都只有 5 张图片）。

Private Sub ComboBox1_Change()
pic1 = "C:\Temp\Photos\" & Me.ComboBox1.Text & ".jpg"
pic2 = "C:\Temp\Photos\" & Me.ComboBox1.Text & ".jpg"
pic3 = "C:\Temp\Photos\" & Me.ComboBox1.Text & ".jpg"
pic4 = "C:\Temp\Photos\" & Me.ComboBox1.Text & ".jpg"
pic5 = "C:\Temp\Photos\" & Me.ComboBox1.Text & ".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

回答by Siddharth Rout

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.

就像我提到的，没有内置的方法可以在用户表单中旋转图片。话虽如此，有一种替代方法可以实现您想要的。下面我演示了如何将图像旋转 90 度。

Logic:

逻辑：

1. Insert a temp sheet

2. Insert the image into that sheet

3. Use IncrementRotationrotation property

4. Export the image to user's temp directory

5. Delete the temp sheet

6. Load the image back

1. 插入临时表

2. 将图像插入该工作表

3. 使用IncrementRotation旋转属性

4. 将图像导出到用户的临时目录

5. 删除临时表

6. 加载回图像

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 PictureSizeModeto fmPictureSizeModeStretchin the properties window.

创建一个用户窗体并插入一个图像控件和一个命令按钮。您的表单可能如下所示。设置图像控件PictureSizeMode到fmPictureSizeModeStretch在属性窗口。

Code:

代码：

I have written a sub RotatePicto 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 :)

我写了一个RotatePic你可以通过学位的子。就像我提到的，这个例子将它旋转 90 度，因为我只是在演示90. 您可以为其余的度数创建额外的按钮。我还对代码进行了注释，因此您理解它应该没有任何问题。如果你这样做，那么简单地问:)

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!

当你运行用户表单时，图像被上传，当你点击按钮时，图像被旋转！

回答by Bernard Saucier

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
   

1. 改变

   If Dir(pic1) <> vbNullString Then
   Me.Image1.Picture = LoadPicture(pic1)
   Else ...
   

   到

   If Dir(pic1) <> vbNullString Then 
   pic1 = myFunction(pic1, rotationDegree)
   Me.Image1.Picture = LoadPicture(pic1)
   Else ...
   

   （在其他任何地方都使用这种结构）

2. 在模块中插入以下函数：

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

EDIT2 :rotationDegree 需要设置为旋转的度数（需要在检索图片之前确定）。