且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

使用VBA旋转保存的图像

更新时间:2023-12-05 16:06:34

就像我提到的那样,没有内置的方式可以旋转用户窗体中的图片.话虽如此,还有一种替代方法可以实现您想要的.下面我演示了如何将图像旋转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.

逻辑:

  1. 插入临时表

  1. 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!